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
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!
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)