Issue with looping through sheets in excel files and save as csv files

Question

I am writing a function that iterates through files in a folder. In each file, iterate through the sheets and save them as CSV files. I tested them without going through the sheets and it works fine. However, when I loop through the sheets, it keeps looping through the files. I ran the debug and found that when it is at the end of the last file, it goes back to the first file. I cannot find what was wrong. Here is my code:

Sub morningstar_VBA()
'PURPOSE: To loop through all Excel files in a user specified folder and perform a set task on them
'SOURCE: www.TheSpreadsheetGuru.com

Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim filename As String
Dim path_to_save As String
Dim FldrPicker As FileDialog
Dim w As Long

'Retrieve Target Folder Path From User
  Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)

    With FldrPicker
      .Title = "Select A Target Folder"
      .AllowMultiSelect = False
        If .Show <> -1 Then GoTo NextCode
        myPath = .SelectedItems(1) & "\"
    End With

'In Case of Cancel
NextCode:
  myPath = myPath
  If myPath = "" Then GoTo ResetSettings

'Target File Extension (must include wildcard "*")
  myExtension = "*.xlsx*"

'Target Path with Ending Extention
  myFile = Dir(myPath & myExtension)

'Loop through each Excel file in folder
  Do While myFile <> ""
    'Set variable equal to opened workbook
    Set wb = Workbooks.Open(filename:=myPath & myFile)

    'Ensure Workbook has opened before moving on to next line of code
    For w = 1 To Worksheets.Count
        With Worksheets(w).Copy
            'the ActiveWorkbook is now the new workbook populated with a copy of the current worksheet
            With ActiveWorkbook
                filename = .Worksheets(1).Name
                path_to_save = "E:\Morningstar_download\test\" & filename
                .SaveAs filename:=path_to_save, FileFormat:=xlCSV
                DoEvents
                .Close savechanges:=False
            End With
        End With
    Next w

    wb.Close savechanges:=True

    'Ensure Workbook has closed before moving on to next line of code
    DoEvents

    'Get next file name
    myFile = Dir
  Loop

'Message Box when tasks are completed
  MsgBox "Task Complete!"

ResetSettings:
  'Reset Macro Optimization Settings
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

End Sub

I think i found the issue but I don't know how to fix it. If I change "wb.Close savechanges:=True" to False, it works. But I would like to save the file too. — duckman, May 11 '20 at 09:13
@Dorian yes, i commented yesterday but i dont know why the comment disappeared. It returns an error — duckman, May 13 '20 at 05:58

TourEiffel · Accepted Answer · 2020-05-13T09:23:53.063

2

Maybe try this out :

Sub morningstar_VBA()
'PURPOSE: To loop through all Excel files in a user specified folder and perform a set task on them
'SOURCE: www.TheSpreadsheetGuru.com

Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim filename As String
Dim path_to_save As String
Dim FldrPicker As FileDialog
Dim w As Long

'Retrieve Target Folder Path From User
  Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)

    With FldrPicker
      .Title = "Select A Target Folder"
      .AllowMultiSelect = False
        If .Show <> -1 Then GoTo NextCode
        myPath = .SelectedItems(1) & "\"
    End With

'In Case of Cancel
NextCode:
  myPath = myPath
  If myPath = "" Then GoTo ResetSettings

'Target File Extension (must include wildcard "*")
  myExtension = "*.xlsx*"

'Target Path with Ending Extention
  myFile = Dir(myPath & myExtension)

'Loop through each Excel file in folder
  Do While myFile <> ""
    'Set variable equal to opened workbook
    Set wb = Workbooks.Open(filename:=myPath & myFile)
    Windows(wb.Name).Visible = False

    'Ensure Workbook has opened before moving on to next line of code
    For w = 1 To wb.Worksheets.Count
        With wb.Worksheets(w).Copy
            'the ActiveWorkbook is now the new workbook populated with a copy of the current worksheet
                filename = ActiveWorkbook.Worksheets(1).Name
                path_to_save = "E:\Morningstar_download\test\" & filename

     wb.SaveAs Filename:="E:\Morningstar_download\test\" & filename & ".csv", FileFormat:=xlCSVWindows
Workbooks( Worksheets(w).Name & ".XLS").Close

        End With
    Next w

    wb.Close savechanges:=True

    'Ensure Workbook has closed before moving on to next line of code
    DoEvents

    'Get next file name
    myFile = Dir
  Loop

'Message Box when tasks are completed
  MsgBox "Task Complete!"

ResetSettings:
  'Reset Macro Optimization Settings
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

End Sub

edited May 13 '20 at 09:23

answered May 11 '20 at 10:09

TourEiffel

4,034
2
16
45

The error was : "run-time error '9': Subscript out of range" when I debugged, it is the line With Worksheets(w).Copy that causes the issue. – duckman May 13 '20 at 07:26
@duckman whats the value of w ? Maybe it is because Worksheets(w) does not exist, so please check the value of w when it does the issue by puting your mouse pointer on it and tell me :) – TourEiffel May 13 '20 at 07:27
w was 2. Some how the new csv file is open. how to stop it from openning? – duckman May 13 '20 at 07:32
@duckman I edited code by adding `Windows(wb.Name).Visible = False`. Do you have 2 Sheet in workbook ? – TourEiffel May 13 '20 at 07:34
Unfortunately, still the same error message and issue. I tried with a 2-sheet and 3-sheet xlsx files. w is 2 in both cases, so I think the issue is when it opens the second sheet – duckman May 13 '20 at 07:58
hey it works. But it creates many book1, book2, book3, etc for the sheets. how do I close that temporary book when the file is saved? – duckman May 13 '20 at 09:09
@duckman just added `Workbooks( Worksheets(w).Name & ".XLS").Close` maybe if it does not work edit the **XLS** extension to the good one ! – TourEiffel May 13 '20 at 09:24
I added " ActiveWorkbook.Close savechanges:=False" before the "Next w" part. It works – duckman May 13 '20 at 09:39
Let us [continue this discussion in chat](https://chat.stackoverflow.com/rooms/213765/discussion-between-duckman-and-dorian). – duckman May 13 '20 at 09:42
oh. And how can you answer random questions on the internet? lolz. I just want to thank you for your help. Do you mind having a look at my related issue in the following link ? https://stackoverflow.com/questions/61767545/open-a-sheet-execute-a-function-from-an-add-in-and-save – duckman May 13 '20 at 10:08

Max · Answer 2 · 2020-05-12T07:37:23.970

i would split this into two parts; mainly because it is easier to handle the code, but also in case you need parts of the code in other circumstances. The sub "Dateien_auswaehlen" can be used to do anything with the choosen files, just by choosing some other routine then morningstar:

    Sub Dateien_auswaehlen()
    Dim FldrPicker As FileDialog
    Dim fso As Object
    Dim objFld As Object
    Dim objFiles As Object
    Dim file
    Dim myPath As String

    'Retrieve Target Folder Path From User
      Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)

        With FldrPicker
          .Title = "Select A Target Folder"
          .AllowMultiSelect = False
            If .Show <> -1 Then GoTo NextCode
            myPath = .SelectedItems(1) & "\"
            End With

        'In Case of Cancel
    NextCode:
          myPath = myPath
      If myPath = "" Then GoTo ResetSettings

    'Target File Extension (must include wildcard "*")
      myExtension = "*.xlsx*"

    'Target Path with Ending Extention
      myFile = Dir(myPath & myExtension)

        Set fso = CreateObject("Scripting.FileSystemObject")
        Set objFld = fso.GetFolder(myPath)
        Set objFiles = objFld.Files
            For Each file In objFiles
'here any sub can be called for working with the files found:
                If LCase(file.Name) Like myExtension Then Call morningstar_VBA(myPath, file.Name)
            Next

    'Message Box when tasks are completed
      MsgBox "Task Complete!"

        Set fso = Nothing
        Set objFld = Nothing
        Set objFiles = Nothing
ResetSettings:
      'Reset Macro Optimization Settings
        Application.EnableEvents = True
        Application.Calculation = xlCalculationAutomatic
        Application.ScreenUpdating = True
    End Sub


    Sub morningstar_VBA(path As String, filename As String)
    Dim wb As Workbook
    Dim myFile As String
    Dim myExtension As String
    Dim path_to_save As String
    Dim w As Long

        Set wb = Workbooks.Open(path & filename)

        'Ensure Workbook has opened before moving on to next line of code
        For w = 1 To Worksheets.Count
            With Worksheets(w).Copy
                'the ActiveWorkbook is now the new workbook populated with a copy of the current worksheet
                With ActiveWorkbook
                    filename = .Worksheets(1).Name
                    path_to_save = "E:\Morningstar_download\test\" & filename
                    .SaveAs filename:=path_to_save, FileFormat:=xlCSV
                    DoEvents
                    .Close savechanges:=False
                End With
            End With
        Next w

        wb.Close savechanges:=True

        'Ensure Workbook has closed before moving on to next line of code
        DoEvents
    End Sub

Hi. Your code returns an error at ".SaveAs filename:=path_to_save, FileFormat:=xlCSV" Can you please explain why you would split it into 2 parts? sorry for my zero VBA skills — duckman, May 12 '20 at 00:58

Issue with looping through sheets in excel files and save as csv files

2 Answers2