Macro to open multiple workbook and save as CSV

[howard]

I am looking for a macro to open multiple files in C:\Sales Report and to save these as CSV files in same directory


Your assistance is most appreciated

 

[HaHoBe]

Hi howard,

maybe something like

Sub MrE_1225076_161620A()
' https://www.mrexcel.com/board/threads/macro-to-open-multiple-workbook-and-save-as-csv.1225076/
  Dim strPath       As String
  Dim strFile       As String
  Dim wbkToOpen     As Workbook
  Dim wksTab        As Worksheet
  Dim lngNumTabs    As Long
  
  With Application
    .DisplayAlerts = False
    .ScreenUpdating = False
  End With
  
  strPath = "C:\Sales Report\"
  strFile = Dir(strPath & "*.xls*")
  
  Do While Len(strFile) > 0
    If strFile <> ThisWorkbook.Name Then
      Set wbkToOpen = Workbooks.Open(strPath & strFile)
      strFile = Left(strFile, InStrRev(strFile, ".") - 1)
      If wbkToOpen.Sheets.Count > 1 Then
        lngNumTabs = 1
        For Each wksTab In wbkToOpen.Worksheets
          wksTab.Copy
          ActiveWorkbook.SaveAs Filename:=strFile & "-" & lngNumTabs _
              & ".csv", FileFormat:=xlCSV, CreateBackup:=False
          ActiveWorkbook.Close False
          lngNumTabs = lngNumTabs + 1
        Next wksTab
        wbkToOpen.Close False
      Else
        wbkToOpen.SaveAs Filename:=strFile & ".csv", FileFormat:=xlCSV, CreateBackup:=False
        wbkToOpen.Close False
      End If
    End If
    
    strFile = Dir
  Loop
  
  Set wbkToOpen = Nothing
  
  With Application
    .ScreenUpdating = True
    .DisplayAlerts = True
  End With
  
End Sub

If there are any events in ThisWorkbook or behind the sheets you should disable EnableEvents at the start of the procedure and enable at the end.

Holger

 

[howard]

Thanks for the Help Holger

I need your code amended, so I can select the files in C:\Sales Reports that are to be opened and converted to CSV files


Your assiostance is most appreciated

 

[HaHoBe]

Hi howard,

like

Sub MrE_1225076_161620A_mod01()
' https://www.mrexcel.com/board/threads/macro-to-open-multiple-workbook-and-save-as-csv.1225076/
' Updated: 20221220
' Reason:  changed code from all files in folder to selected files only

' CTRL needs to be pressed for selecting multiple files
  
  Dim objFD         As FileDialog
  Dim lngNumTabs    As Long
  Dim lngCounter    As Long
  Dim strFile       As String
  Dim wbkToOpen     As Workbook
  Dim wksTab        As Worksheet
  
  Set objFD = Application.FileDialog(msoFileDialogFilePicker)
  With objFD
    .AllowMultiSelect = True
    .ButtonName = "Open"
    .Title = "Select Files"
    .InitialFileName = "C:\Sales Report\"
    .Filters.Clear
    .Filters.Add "Excel files", "*.xls*"
    If objFD.Show = -1 Then
      With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
      End With
      For lngCounter = 1 To objFD.SelectedItems.Count
        Set wbkToOpen = Workbooks.Open(objFD.SelectedItems(lngCounter))
        strFile = Left(wbkToOpen.FullName, InStrRev(wbkToOpen.FullName, ".") - 1)
        If wbkToOpen.Sheets.Count > 1 Then
          lngNumTabs = 1
          For Each wksTab In wbkToOpen.Worksheets
            wksTab.Copy
            ActiveWorkbook.SaveAs Filename:=strFile & "-" & lngNumTabs _
                & ".csv", FileFormat:=xlCSV, CreateBackup:=False
            ActiveWorkbook.Close False
            lngNumTabs = lngNumTabs + 1
          Next wksTab
          wbkToOpen.Close False
        Else
          wbkToOpen.SaveAs Filename:=strFile & ".csv", FileFormat:=xlCSV, CreateBackup:=False
          wbkToOpen.Close False
        End If
      Next lngCounter
    End If
  End With
  
  Set wbkToOpen = Nothing
  
  With Application
    .ScreenUpdating = True
    .DisplayAlerts = True
  End With

End Sub

Ciao,
Holger

 

[howard]

Hi Holger


This works 100%