VBA Excel - Convert each sheet to CSV - For MAC

gistfile1.vb

Function SaveAllSheetsAsCSV(outputPath As String)
On Error GoTo Heaven

' each sheet reference
Dim Sheet As Worksheet
' path to output to
'Dim outputPath As String
' name of each csv
Dim OutputFile As String

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False

' ask the user where to save
'outputPath = "." 'InputBox("Enter a directory to save to", "Save to directory", Path)

If outputPath <> "" Then

    ' save for each sheet
    For Each Sheet In Sheets

        OutputFile = outputPath & Replace(ActiveWorkbook.Name, ".xls", "-") & Sheet.Name & ".csv"

        ' make a copy to create a new book with this sheet
        ' otherwise you will always only get the first sheet
        Sheet.Copy
        ' this copy will now become active
        ActiveWorkbook.SaveAs Filename:=OutputFile, FileFormat:=xlCSV, CreateBackup:=False
        ActiveWorkbook.Close savechanges:=False
    Next

End If

Finally:
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True

Exit Function

Heaven:
MsgBox "Couldn't save all sheets to CSV." & vbCrLf & _
        "Source: " & Err.Source & " " & vbCrLf & _
        "Number: " & Err.Number & " " & vbCrLf & _
        "Description: " & Err.Description & " " & vbCrLf

GoTo Finally
End Function


Function FileList(fldr As String, Optional fltr As String = "*.xls") As Variant
    Dim sTemp As String, sHldr As String
    If Right$(fldr, 1) <> Application.PathSeparator Then fldr = fldr & Application.PathSeparator
    sTemp = Dir(fldr & filtr)
    If sTemp = "" Then
        FileList = False
        Exit Function
    End If
    Do
        sHldr = Dir
        If sHldr = "" Then Exit Do
        sTemp = sTemp & "|" & sHldr
     Loop
    FileList = Split(sTemp, "|")
End Function

Sub Convert_Files_To_CSV()  
   
    strOrigFile = ActiveWorkbook.Name
    Debug.Print "Current dir " & ActiveWorkbook.FullName
    Dim inputPath As String
    inputPath = "Macintosh HD:Users:me:Desktop:dirWithXlsFiles"
    If Right$(inputPath, 1) <> Application.PathSeparator Then inputPath = inputPath & Application.PathSeparator
    Debug.Print "input path" & inputPath
    
    ' output directory
    Dim outputPath As String
    outputPath = inputPath & "csv"
    Dim iTemp As Integer
    On Error Resume Next
    iTemp = GetAttr(outputPath)
    Select Case Err.Number
    Case Is = 0
        FileOrDirExists = True
    Case Else
        FileOrDirExists = False
        MkDir outputPath
    End Select
    
    If Right$(outputPath, 1) <> Application.PathSeparator Then outputPath = outputPath & Application.PathSeparator
    
    Dim listPaths
    listPaths = FileList(inputPath)
    Dim res
    
    If TypeName(listPaths) <> "Boolean" Then
        For i = LBound(listPaths) To UBound(listPaths)
            Debug.Print "-----------------------------------------------------"
            Debug.Print listPaths(i)
            Workbooks.Open inputPath & listPaths(i)
            strCurrentWBName = ActiveWorkbook.Name
            
            If strOrigFile <> strCurrentWBName Then
                res = SaveAllSheetsAsCSV(outputPath)
                Windows(strCurrentWBName).Close
                
            End If
        Next
    Else
         MsgBox "No files found"
    End If
    

End Sub