Save Functions‎ > ‎

Files to CSV

  1. A CSV version is created for all xls files in a single folder
  2. User can select the folder
  3. Original files are not damaged/changed
  4. The Excel file that has this macro in it should not be in the folder that is being processed.


Option Explicit

Sub FilesToCSVs()
'Author:    Jerry Beaucaire
'Date:      5/20/2011
'Summary:   All files in a folder are opened, each sheet saved as a CSV

Dim fPath As String
Dim fName As String
Dim wbXL  As Workbook
Dim ws    As Worksheet
Dim shCnt As Long

'Folder selection popup
    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        .InitialFileName = "C:\2009\"    'default folder
        If .SelectedItems.Count > 0 Then
            fPath = .SelectedItems(1) & "\"
            Exit Sub
        End If
    End With

    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    fName = Dir(fPath & "*.xl*")
    Do While Len(fName) > 0
        If fName <> ThisWorkbook.Name Then
            Set wbXL = Workbooks.Open(fPath & fName)
            fName = Left(fName, InStrRev(fName, ".") - 1)
            If wbXL.Sheets.Count > 1 Then
                shCnt = 1
                For Each ws In wbXL.Worksheets
                    ActiveWorkbook.SaveAs Filename:=fName & "-" & shCnt _
                        & ".csv", FileFormat:=xlCSV, CreateBackup:=False
                    ActiveWorkbook.Close False
                    shCnt = shCnt + 1
                Next ws
                wbXL.Close False
                ActiveWorkbook.SaveAs Filename:=fName & ".csv", _
                    FileFormat:=xlCSV, CreateBackup:=False
                ActiveWorkbook.Close False
            End If
        End If
        fName = Dir
    Application.ScreenUpdating = True
End Sub