Hello,

The code below works almost perfectly except for two flaws:

  1. It provides the full name of the file (workbook.xls) instead of just "workbook"
  2. 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
This article has been dead for over six months. Start a new discussion instead.