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
@brauer-t

This comment has been minimized.

Copy link

@brauer-t brauer-t commented Sep 6, 2021

Hi
this looks just like the code i need! Thank you! Could you give further information about how to use it? If i just copy paste it into a new vba module wont start. Do I need to do anthing specific?

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment