run vba on all files in folder

VBA Run Macro on All Files in a Folder / All Worksheets in a Workbook

A very popular Excel automation scenario is the need to a VBA run macro on all files in a folder or running VBA on all Worksheets in an Excel Workbook. This is a very typical case where you process similar data dump files and want to extract data or transform the workbook. In this post I will provide ready code snippets to address these scenarios and walk you through what happens.

VBA Run Macro on All Files in a Folder

To run macro on all files in folder use the code snippet below. The code will do the following:

  • Open a VBA FileDialog in the current workbook path and ask for you to select a folder where all files are stored
  • It will open a separate Excel process (Application) and then open each file one by one
  • Replace the YOUR CODE HERE section with any code you want to run on every opened workbook
  • Each opened workbook will be closed w/o saving

To make it more simple currWb and currWS represent the ActiveWorkbook and ActiveWorksheet whereas wb represents the newly opened Workbook from the selected folder.

Sub RunOnAllFilesInFolder()
    Dim folderName As String, eApp As Excel.Application, fileName As String
    Dim wb As Workbook, ws As Worksheet, currWs As Worksheet, currWb As Workbook
    Dim fDialog As Object: Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
    Set currWb = ActiveWorkbook: Set currWs = ActiveSheet

    'Select folder in which all files are stored
    fDialog.Title = "Select a folder"
    fDialog.InitialFileName = currWb.Path
    If fDialog.Show = -1 Then
      folderName = fDialog.SelectedItems(1)
    End If
    
    
    'Create a separate Excel process that is invisibile
    Set eApp = New Excel.Application:  eApp.Visible = False
    
    'Search for all files in folder [replace *.* with your pattern e.g. *.xlsx]
    fileName = Dir(folderName & "\*.*")
    Do While fileName <> ""
        'Update status bar to indicate progress
        Application.StatusBar = "Processing " & folderName & "\" & fileName


        Set wb = eApp.Workbooks.Open(folderName & "\" & fileName)
        '...
        'YOUR CODE HERE
        '...
        wb.Close SaveChanges:=False 'Close opened worbook w/o saving, change as needed
        Debug.Print "Processed " & folderName & "\" & fileName 
        fileName = Dir()
    Loop
    eApp.Quit
    Set eApp = Nothing
    'Clear statusbar and notify of macro completion
    Application.StatusBar = ""
    MsgBox "Completed executing macro on all workbooks"
End Sub

There is also built in simple progress tracking via the Application StatusBar.

VBA Run Macro on All Files in Subfolders

A scenario of the above case when you want to run a macro on all Excel files in a folder is also traversing all subfolders to run your macro. The below is an extension of the above and utilizes a slightly modified version of the TraversePath procedure from here.

The below is almost identical to the above, however, notice the global variable fileCollection. This will be used to first store all file identified in subfolders and only after used to run all macros on files stored in this VBA Collection.

Dim fileCollection As Collection
Sub TraversePath(path As String)
    Dim currentPath As String, directory As Variant
    Dim dirCollection As Collection
    Set dirCollection = New Collection
    
    currentPath = Dir(path, vbDirectory)
    
    'Explore current directory
    Do Until currentPath = vbNullString
        Debug.Print currentPath
        If Left(currentPath, 1) <> "." And (GetAttr(path & currentPath) And vbDirectory) = vbDirectory Then
            dirCollection.Add currentPath
        ElseIf Left(currentPath, 1) <> "." And (GetAttr(path & currentPath) And vbNormal) = vbNormal Then
            fileCollection.Add path & currentPath
        End If
        currentPath = Dir()
    Loop
    
    'Explore subsequent directories
    For Each directory In dirCollection
        Debug.Print "---SubDirectory: " & directory & "---"
        TraversePath path & directory & "\"
    Next directory
End Sub

Sub RunOnAllFilesInSubFolders()
    Dim folderName As String, eApp As Excel.Application, fileName As Variant
    Dim wb As Workbook, ws As Worksheet, currWs As Worksheet, currWb As Workbook
    Dim fDialog As Object: Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
    Set currWb = ActiveWorkbook: Set currWs = ActiveSheet

    'Select folder in which all files are stored
    fDialog.Title = "Select a folder"
    fDialog.InitialFileName = currWb.path
    If fDialog.Show = -1 Then
      folderName = fDialog.SelectedItems(1)
    End If
    
    
    'Create a separate Excel process that is invisibile
    Set eApp = New Excel.Application:  eApp.Visible = False
    
    'Search for all files in folder [replace *.* with your pattern e.g. *.xlsx]
    Set fileCollection = New Collection
    TraversePath folderName & "\"

    For Each fileName In fileCollection
        'Update status bar to indicate progress
        Application.StatusBar = "Processing " & fileName


        Set wb = eApp.Workbooks.Open(fileName)
        '...
        'YOUR CODE HERE.
        '...
        wb.Close SaveChanges:=False 'Close opened worbook w/o saving, change as needed
        Debug.Print "Processed " & fileName  'Print progress on Immediate window
    Next fileName
    eApp.Quit
    Set eApp = Nothing
    'Clear statusbar and notify of macro completion
    Application.StatusBar = ""
    MsgBox "Completed executing macro on all workbooks"
End Sub

Run VBA on All Worksheets

To run macro on all Sheets in Workbook you need to can use the code snippet below. Here is a walkthrough of the code:

  • Opens each worksheet in ActiveWorkbook that isn’t the ActiveSheet. This clause is to avoid running on Worksheet on which macro was activated assuming this is a working sheet, feel free to remove the If clause if needed.
  • Replace the YOUR CODE HERE section with any code you want to run on every opened Worksheet
Sub RunOnAllWorksheets()
    Dim folderName As String, eApp As Excel.Application, fileName As String
    Dim ws As Worksheet, currWs As Worksheet, currWb As Workbook
    Dim fDialog As Object: Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
    Set currWb = ActiveWorkbook: Set currWs = ActiveSheet

    
    'Search for all files in folder [replace *.* with your pattern e.g. *.xlsx]
    
    For Each ws In Sheets
        If ws.Name <> currWs.Name Then
            'Update status bar to indicate progress
            Application.StatusBar = "Processing " & ws.Name
            '...
            'YOUR CODE HERE
            '...
            Debug.Print "Processed " & ws.Name
        End If
    Next ws
    'Clear statusbar and notify of macro completion
    Application.StatusBar = ""
    MsgBox "Completed executing macro on all worksheets"
End Sub

2 Comments

  1. Your code is very helpful. I have run into one issue I can’t solve. This is proving to be a bug if one is accessing a SharePoint site. I am using your code for “VBA Run Macro on all files in a folder” to update all files in a folder. As long as the folder chosen (with the file picker) is in the “C:\user\documents” format the VBA code runs fine. However if a SharePoint site is chosen the file picker displays the address in the following format “http://sharepoint3.abc.com/sites/documents” the DIR code fails. The two solutions I have identified I do not have a solution for:
    1) Modify the code “Dir(folderName & “/” & “*.xlsm”) so that it accepts the sharepoint address format “http://sharepoint3.abc.com/sites/documents”
    2)Identify a way to change the address to a UNC format “\\sharepoint3.abc.com\sites\documents”

    Any help is appreciated!

  2. Copy and paste your code, just get RED ERRORS on these lines
    fileName = Dir(folderName & “\*.xlsx”)
    Do While fileName <> “”
    ‘Update status bar to indicate progress
    Application.StatusBar = “Processing ” & folderName & “\” & fileName

    Set wb = eApp.Workbooks.Open(folderName & “\” & fileName)

Leave a Reply

Your email address will not be published. Required fields are marked *

This site uses Akismet to reduce spam. Learn how your comment data is processed.