Need to Export All Worksheets from All Workbooks in Folder to Separate FIles not as CSV Files

S

socrtwo

I posted earlier about this script (http://tinyurl.com/ydbo3c)
searching for a way to select which file format to export to and Bob
Phillips kindly helped out. Unfortunately, if you choose an Excel
format it just save multiple copies of the original file instead of
exporting each file separately as an xls file. So I'll start over.

I want to use this Dave Peterson script (http://tinyurl.com/yd9dp3)
below to export all worksheets in all workbooks in a folder to separate
xls files. The script works as configured for csv files, but if you
change the line FileFormat:=xlCSV to xlWorkbookNormal or xlExcel9795
(seehttp://msdn2.microsoft.com/en-us/library/microsoft.office.interop.excel.xlfileformat.aspx),
the script doesn't work but saves multiple copies of each original xls
file with all the worksheets intact in each file.

Option Explicit
Private Sub CommandButton1_Click()

Dim myfiles() As String
Dim i As Integer
Dim myfile As String
Dim myfolder As String
Dim strpath As String
Dim strfilename As String

Dim wks As Worksheet

myfolder = InputBox("Enter complete path to the Excel files you wish to
convert to CSV format. Put an \ on the end of the path.", "Excel File
Folder Path")

With Application.FileSearch
.NewSearch
.LookIn = myfolder
.SearchSubFolders = True
.Filename = "*.xls"
If .Execute() > 0 Then
ReDim Preserve myfiles(1 To .FoundFiles.Count)
Application.StatusBar = "Found Files: " &
..FoundFiles.Count
For i = 1 To .FoundFiles.Count
myfiles(i) = .FoundFiles(i)
Next i
Else
MsgBox "There were no files found."
Exit Sub
End If

End With

For i = LBound(myfiles) To UBound(myfiles)
Application.StatusBar = "Processing #" & i & ": " & myfiles(i)

Workbooks.Open Filename:=myfiles(i), ReadOnly:=True,
UpdateLinks:=False

For Each wks In ActiveWorkbook.Worksheets
wks.Activate
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs _
Filename:=Left(myfiles(i), Len(myfiles(i)) - 4) & "_" _
& wks.Name, _
FileFormat:=xlCSV
Application.DisplayAlerts = True
Next wks

ActiveWorkbook.Close savechanges:=False

Next i

Application.StatusBar = False

End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top