Hello,
The code below works almost perfectly except for two flaws:
- It provides the full name of the file (workbook.xls) instead of just "workbook"
- If there is more than 1 worksheet then the loop appends the previous worksheet to the filename.
For example,
Workbook1 has 1 worksheet
Workbook2 has 2 worksheets
Workbook3 has 1 worksheet
Result is
Workbook1.xls-Sheet1.csv
Workbook2.xls-Sheet1.csv
Workbook2.xls-Sheet1-Sheet2.csv
Workbook3.xls-Sheet1.csv
Desired outcome:
Workbook1-Sheet1.csv
Workbook2-Sheet1.csv
Workbook2-Sheet2.csv
Workbook3-Sheet1.csv
I can probably figure out how to strip off the ".xls" from the filename but I don't get why the loop appends the current worksheet name to the previous one.
Sub SaveToCSVs()
Dim fDir As String
Dim wB As Workbook
Dim wS As Worksheet
Dim fPath As String
Dim sPath As String
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = False
objExcel.DisplayAlerts = False
fPath = "C:\temp\pydev\"
sPath = "C:\temp\"
fDir = Dir(fPath)
Do While (fDir <> "")
If Right(fDir, 4) = ".xls" Or Right(fDir, 5) = ".xlsx" Then
On Error Resume Next
Set wB = Workbooks.Open(fPath & fDir)
For Each wS In wB.Sheets
' MsgBox (wB.Name & "-" & wS.Name)
wS.SaveAs sPath & wB.Name & "-" & wS.Name & ".csv", xlCSV
Next wS
wB.Close False
Set wB = Nothing
End If
fDir = Dir
On Error GoTo 0
Loop
End Sub