Code Or Command To Open XLSM Files And Close And Save As CSV

[Dazzawm]

Hi, is there a code or command that will open a load of xlsm files within a folder and then close and save them as csv files either in the same folder or a specified location? Thanks.

 

[Dazzawm]

Any ideas anyone please?

 

[Dazzawm]

^

 

[Dazzawm]

Surely someone can help with this please??!!

 

[bertie]

Hi Daz, thanks for the pm.

This will probably need some editing at your end so I will walk you through the code.

First we set up the folder to process, REMEMBER the trailing backslash, and set the file variable to the first XLSM file in that folder.

   sPath = "C:\temp\" 'REMEMBER TRAILING BACKSLASH
   sFile = Dir(sPath & "*.xlsm")

You will get an alert when saving as a csv file, i.e., only one sheet, lose Excel functionality, etc; so we will disable alerts. An error trap will ensure the application settings are reset before the code ends.

   'disable saving CSV alerts - use error trap to ensure application settings are reset
   On Error GoTo errHandler
   Application.DisplayAlerts = False

We loop through the files until no more XLSM files are found:

   'loop through the folder
   Do Until sFile = ""

Set the source workbook variable, open the SOURCE wourbook and build up the new file name:

      'open the workbook and build the new file name
      Set wbSource = Workbooks.Open(sPath & sFile)
      newFileName = sPath & Replace(wbSource.Name, "xlsm", "") & ".csv"

ASSUME the sheet to be saved as csv is the first worksheet - EDIT if necessary.
Copy this sheet into a new target workbook.
Save the target workbook as a csv file.
Close source and target files.

      'ASSUME sheet to be saved as csv is first worksheet
      wbSource.Worksheets(1).Copy
      Set wbTarget = ActiveWorkbook
      wbTarget.SaveAs Filename:=newFileName, FileFormat:=xlCSV
      wbTarget.Close SaveChanges:=False
      wbSource.Close SaveChanges:=False

Clear the variables from memory and get the next file.

      'get next fileThis will probably need some editing at your end
      Set wbSource = Nothing
      Set wbTarget = Nothing
      sFile = Dir()
   Loop

And end of with our error trap ensuring the Application setting we disabled are reset.

errHandler:
   Application.DisplayAlerts = True
End Sub

Putting it all together, place the code in a standard module, i.e., Insert=>Module.

Option Explicit


Sub SaveAsCsv()
   Dim sPath As String
   Dim sFile As String
   Dim wbSource As Workbook
   Dim wbTarget As Workbook
   Dim newFileName As String
   
   sPath = "C:\temp\" 'REMEMBER TRAILING BACKSLASH
   sFile = Dir(sPath & "*.xlsm")
   
   'disable saving CSV alerts - use error trap to ensure application settings are reset
   On Error GoTo errHandler
   Application.DisplayAlerts = False
   
   'loop through the folder
   Do Until sFile = ""
      
      'open the workbook and build the new file name
      Set wbSource = Workbooks.Open(sPath & sFile)
      newFileName = sPath & Replace(wbSource.Name, "xlsm", "") & ".csv"
      
      'ASSUME sheet to be saved as csv is first worksheet
      wbSource.Worksheets(1).Copy
      Set wbTarget = ActiveWorkbook
      wbTarget.SaveAs Filename:=newFileName, FileFormat:=xlCSV
      wbTarget.Close SaveChanges:=False
      wbSource.Close SaveChanges:=False
      
      'get next fileThis will probably need some editing at your end
      Set wbSource = Nothing
      Set wbTarget = Nothing
      sFile = Dir()
   Loop
   
errHandler:
   Application.DisplayAlerts = True
End Sub

Hope this helps,
Bertie

 

[bertie]

Update - I have edited the highlighted line.

Option Explicit


Sub SaveAsCsv()
   Dim sPath As String
   Dim sFile As String
   Dim wbSource As Workbook
   Dim wbTarget As Workbook
   Dim newFileName As String
   
   sPath = "C:\temp\" 'REMEMBER TRAILING BACKSLASH
   sFile = Dir(sPath & "*.xlsm")
   
   'disable saving CSV alerts - use error trap to ensure application settings are reset
   On Error GoTo errHandler
   Application.DisplayAlerts = False
   
   'loop through the folder
   Do Until sFile = ""
      
      'open the workbook and build the new file name
      Set wbSource = Workbooks.Open(sPath & sFile)
      newFileName = sPath & Replace(wbSource.Name, ".xlsm", ".csv")
      
      'ASSUME sheet to be saved as csv is first worksheet
      wbSource.Worksheets(1).Copy
      Set wbTarget = ActiveWorkbook
      wbTarget.SaveAs Filename:=newFileName, FileFormat:=xlCSV
      wbTarget.Close SaveChanges:=False
      wbSource.Close SaveChanges:=False
      
      'get next file
      Set wbSource = Nothing
      Set wbTarget = Nothing
      sFile = Dir()
   Loop
   
errHandler:
   Application.DisplayAlerts = True
End Sub

 

[Worf]

Daz also asked for my help, so we have two people working on the same thing. Here is my approach:

Sub UseFileDialogOpen()
' use these key combinations on the file selecting dialog:
' one file = click      block = shift+click         non contiguous = control+click


Dim cnt%, ws As Worksheet
With Application.FileDialog(msoFileDialogOpen)
    .AllowMultiSelect = True
    .Show
    For cnt = 1 To .SelectedItems.Count
        Application.Workbooks.Open (.SelectedItems(cnt))
        For Each ws In ActiveWorkbook.Worksheets
            ws.SaveAs "C:\Users\Public\Documents\" & ws.Name & Replace(Time, ":", "_") & ".csv", xlCSV
        Next
        ActiveWorkbook.Close False
    Next
End With
End Sub

 

[Dazzawm]

Update - I have edited the highlighted line.

Option Explicit


Sub SaveAsCsv()
   Dim sPath As String
   Dim sFile As String
   Dim wbSource As Workbook
   Dim wbTarget As Workbook
   Dim newFileName As String
   
   sPath = "C:\temp\" 'REMEMBER TRAILING BACKSLASH
   sFile = Dir(sPath & "*.xlsm")
   
   'disable saving CSV alerts - use error trap to ensure application settings are reset
   On Error GoTo errHandler
   Application.DisplayAlerts = False
   
   'loop through the folder
   Do Until sFile = ""
      
      'open the workbook and build the new file name
      Set wbSource = Workbooks.Open(sPath & sFile)
      newFileName = sPath & Replace(wbSource.Name, ".xlsm", ".csv")
      
      'ASSUME sheet to be saved as csv is first worksheet
      wbSource.Worksheets(1).Copy
      Set wbTarget = ActiveWorkbook
      wbTarget.SaveAs Filename:=newFileName, FileFormat:=xlCSV
      wbTarget.Close SaveChanges:=False
      wbSource.Close SaveChanges:=False
      
      'get next file
      Set wbSource = Nothing
      Set wbTarget = Nothing
      sFile = Dir()
   Loop
   
errHandler:
   Application.DisplayAlerts = True
End Sub

Thanks Bertie works great for saving in the same location, how about if I want to save to a different folder, what needs changing please?

 

[bertie]

When building the new file name, replace the path variable with the new path in this line:
For example., change this:

      newFileName = sPath & Replace(wbSource.Name, ".xlsm", ".csv")

to (again, REMEMBER the trailing backslash)

      newFileName = "C:\temp\archive\" & Replace(wbSource.Name, ".xlsm", ".csv")

 

[Dazzawm]

Thanks so much Bertie works great. Could I ask one last thing without trying to over complicate things. All the files I will be opening are named in the format of WRegs_Catalog2.3N or Leads_Catalog2.6F etc. When I save them in the specified location can everything before (and including the underscore) be removed and overwrite everything in the file. So I would be left in this instance with Catalog2.3N or Catalog2.6F etc. Thanks.

If its too tricky or having to rewrite a lot I understand.