Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
VBA Excel - Convert each sheet to CSV - For MAC
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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.