A VBA code to save multiple sheets from multiple workbooks (XLSM) to CSV with file name?

[reuben_rambo]

Dear forum and VBA experts:

I came across a post here:
Saving multiple sheets in multiple workbooks to CSV with file name

The VBA code runs a macro on all EXCEL FILE (XLSM) in a folder and exports all the sheets within those files out as a .csv

My current VBA code runs a macro on only ONE excel file (XLSM) that must be opened first, where it exports all those files as a .csv where the CSV file output is solely based on the worksheet name in the XLSM file.

QUESTION
Is it possible to amend the VBA macro (written below) so that it can:

[1] Identify the folder where all the excel files [XLSM] are located; and then

[2] Sequentially opens each XLSM file in the folder identified in [1] and saves each worksheet as a CSV file with naming convention “workbook name_worksheet name.csv”

Thanks,
Reuben


What the current VBA code does?

It saves the worksheets as CSV files into a particular folder with the CSV file names are associated with the exact worksheet names.

To run the VBA code, you must open the XLSM file and then run the macro “SaveWorksheetsasCSV”

THE VBA CODE

Public Sub SaveWorksheetsAsCsv()
Dim xWs As Worksheet
Dim xDir As String
Dim folder As FileDialog
Set folder = Application.FileDialog(msoFileDialogFolderPicker)
If folder.Show <> -1 Then Exit Sub
xDir = folder.SelectedItems(1)
For Each xWs In Application.ActiveWorkbook.Worksheets
xWs.SaveAs xDir & "\" & xWs.Name, xlCSV
Next
End Sub

Thanks, I hope someone has a solution for this. I would be immensely grateful if someone is able to post a solution here.

Best,
Reuben

 

[ceranes]

Hi Reuben,

Here is a summary of what the following code does. I hope this is what you are looking for.

The code prompts the user to select a folder using the FileDialog object, which will be the folder that contains the Excel files (.xlsm).

The code then uses the FileSystemObject to loop through all the files in the selected folder, and for each Excel file with the extension .xlsm, it opens the file using the Excel.Application object, and then loops through all the worksheets in the workbook.

For each worksheet, the code saves the worksheet as a separate CSV file in the same folder as the original Excel files using the naming convention "workbook name_worksheet name.csv".

Finally, the code closes the Excel file and releases the Excel.Application object from memory.

Good luck,
Chris

Public Sub SaveWorksheetsAsCsv()
    Dim xDir As String
    Dim folder As FileDialog
    Dim fso As Object 'FileSystemObject
    Dim objFolder As Object 'Folder
    Dim objFile As Object 'File
    Dim objExcel As Object 'Excel.Application
    Dim objWorkbook As Object 'Workbook
    Dim objWorksheet As Object 'Worksheet
    
    'Prompt user to select the folder that contains the Excel files
    Set folder = Application.FileDialog(msoFileDialogFolderPicker)
    If folder.Show <> -1 Then Exit Sub
    xDir = folder.SelectedItems(1)
    
    'Create a FileSystemObject to loop through all Excel files in the selected folder
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set objFolder = fso.GetFolder(xDir)
    
    'Loop through all Excel files in the selected folder
    For Each objFile In objFolder.Files
        'Check if the file is an Excel file with the extension .xlsm
        If fso.GetExtensionName(objFile.Name) = "xlsm" Then
            'Open the Excel file
            Set objExcel = CreateObject("Excel.Application")
            Set objWorkbook = objExcel.Workbooks.Open(objFile.Path)
            
            'Loop through all worksheets in the Excel file
            For Each objWorksheet In objWorkbook.Worksheets
                'Save each worksheet as a separate CSV file
                objWorksheet.SaveAs fso.BuildPath(xDir, objWorkbook.Name & "_" & objWorksheet.Name & ".csv"), xlCSV
            Next objWorksheet
            
            'Close the Excel file
            objWorkbook.Close False
            objExcel.Quit
            Set objWorkbook = Nothing
            Set objExcel = Nothing
        End If
    Next objFile
End Sub

 

[HaHoBe]

Hi Reuben,

maybe

Public Sub SaveWorksheetsAsCsv()
' https://www.mrexcel.com/board/threads/a-vba-code-to-save-multiple-sheets-from-multiple-workbooks-xlsm-to-csv-with-file-name.1232335/
Dim ws As Worksheet
Dim wbNew As Workbook
Dim strPath As String
Dim strWB As String

With Application.FileDialog(msoFileDialogFolderPicker)
  If .Show = -1 Then
    Application.ScreenUpdating = False
    'get the folder to work in including backslash
    strPath = .SelectedItems(1) & "\"
    'try to get reference to first macro-enabled workbook in folder
    strWB = Dir(strPath & "*.xlsm")
    'loop as long as there is any workbook found
    Do While strWB <> ""
      'open and set object on workbook
      Set wbNew = Workbooks.Open(strPath & strWB)
      'all worksheets in worlbook
      For Each ws In wbNew.Worksheets
        'save under wanted name and extension
        ws.SaveAs strPath & wbNew.Name & "_" & ws.Name & ".csv", xlCSV
      Next ws
      'close workbook
      wbNew.Close False
      'get next workbook in folder
      strWB = Dir()
    Loop
  End If
End With
Set wbNew = Nothing
Application.ScreenUpdating = True
End Sub

Ciao,
Holger