Written by This sub will open the specified file type from the specified directory and sace them as excel files. A file open dialog box will ask the user to select a file from the folder where the original files are kept. Then an output folder name will be asked and this folder should exist otherwise it would generate an error. Make the changes where commented and can be used for all other supported file types. Right now this sub will save the html files as excel files.
Public Sub saveas_XL()
Err.Clear
On Error GoTo errorhandler
Application.ScreenUpdating = False ‘won’t show changes in the application
ActiveSheet.Cells.Clear ‘clear all the contents on the sheet
Dim infile, fpath, cutnum, outputfolder, msg As String, HtmlFpath, n As Long, F
n = 0
‘change *.htm;*.html to the file type you want to save as an excel file
‘ a file open dialog box
infile = Application.GetOpenFilename(“Html Files(*.htm;*.html),*.htm;*.html”, , “Please select the HTML files folder”)
If infile = False Then
Application.ScreenUpdating = True
Exit Sub
End If
‘find path to the files
cutnum = InStrRev(infile, “\”)
fpath = Left(infile, cutnum)
HtmlFpath = fpath
‘change *.html to the file type
F = Dir(fpath & “*.html”) ‘will give the first file in that directory
Range(“A1″).Activate ‘cell A1 selected
Do While Len(F) > 0
ActiveCell.Formula = F
ActiveCell.Offset(1, 0).Select
F = Dir() ‘second file
n = n + 1
Loop
Sheet1.Range(Cells(1, 2), Cells(n, 2)) = Sheet1.Range(Cells(1, 1), Cells(n, 1)).Value
‘change .html to the extension type you want to save as an excel file
Sheet1.Range(Cells(1, 2), Cells(n, 2)).Replace What:=”.html”, Replacement:=”", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
‘will ask for the output folder where you want to save these files, this folder should exist
outputfolder = InputBox(“Enter the outputfolder name”, “Folder name”)
fpath = Left(fpath, Len(fpath) – 1)
cutnum = InStrRev(fpath, “\”)
fpath = Left(fpath, cutnum)
‘will open all the files in Column B and save as xl files
For i = 1 To n
Workbooks.Open Filename:=HtmlFpath & Sheet1.Cells(i, 1)
ActiveWorkbook.SaveAs Filename:=fpath & outputfolder & “\” & Sheet1.Cells(i, 2), FileFormat:=xlWorkbookNormal
ActiveWorkbook.Close
Next i
Application.ScreenUpdating = True
MsgBox “Done”
Exit Sub
errorhandler:
msg = “Error # ” & Str(Err.Number) & ” was generated by ” _
& Err.Source & Chr(13) & Err.Description & vbCrLf & vbCrLf & “Ending program now”
MsgBox msg, , “Error”, Err.HelpFile, Err.HelpContext
Application.ScreenUpdating = True
End Sub
Err.Clear
On Error GoTo errorhandler
Application.ScreenUpdating = False ‘won’t show changes in the application
ActiveSheet.Cells.Clear ‘clear all the contents on the sheet
Dim infile, fpath, cutnum, outputfolder, msg As String, HtmlFpath, n As Long, F
n = 0
‘change *.htm;*.html to the file type you want to save as an excel file
‘ a file open dialog box
infile = Application.GetOpenFilename(“Html Files(*.htm;*.html),*.htm;*.html”, , “Please select the HTML files folder”)
If infile = False Then
Application.ScreenUpdating = True
Exit Sub
End If
‘find path to the files
cutnum = InStrRev(infile, “\”)
fpath = Left(infile, cutnum)
HtmlFpath = fpath
‘change *.html to the file type
F = Dir(fpath & “*.html”) ‘will give the first file in that directory
Range(“A1″).Activate ‘cell A1 selected
Do While Len(F) > 0
ActiveCell.Formula = F
ActiveCell.Offset(1, 0).Select
F = Dir() ‘second file
n = n + 1
Loop
Sheet1.Range(Cells(1, 2), Cells(n, 2)) = Sheet1.Range(Cells(1, 1), Cells(n, 1)).Value
‘change .html to the extension type you want to save as an excel file
Sheet1.Range(Cells(1, 2), Cells(n, 2)).Replace What:=”.html”, Replacement:=”", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
‘will ask for the output folder where you want to save these files, this folder should exist
outputfolder = InputBox(“Enter the outputfolder name”, “Folder name”)
fpath = Left(fpath, Len(fpath) – 1)
cutnum = InStrRev(fpath, “\”)
fpath = Left(fpath, cutnum)
‘will open all the files in Column B and save as xl files
For i = 1 To n
Workbooks.Open Filename:=HtmlFpath & Sheet1.Cells(i, 1)
ActiveWorkbook.SaveAs Filename:=fpath & outputfolder & “\” & Sheet1.Cells(i, 2), FileFormat:=xlWorkbookNormal
ActiveWorkbook.Close
Next i
Application.ScreenUpdating = True
MsgBox “Done”
Exit Sub
errorhandler:
msg = “Error # ” & Str(Err.Number) & ” was generated by ” _
& Err.Source & Chr(13) & Err.Description & vbCrLf & vbCrLf & “Ending program now”
MsgBox msg, , “Error”, Err.HelpFile, Err.HelpContext
Application.ScreenUpdating = True
End Sub
Related posts:
Recent Comments