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

Desired outcome:

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
End Sub
Be a part of the DaniWeb community

We're a friendly, industry-focused community of developers, IT pros, digital marketers, and technology enthusiasts meeting, networking, learning, and sharing knowledge.