Loop through folder and run macro on all workbooks

[danielpuccini]

I am working in Excel 2010 and would like to create a vb macro that loops through all folders and subfolders in a path, performs a macro that I already have recorded, and then saves the files. Can somebody help me write a module for this?

 

[pboltonchina]

This works on 2007 but I don't know about 2010, Try it on a copy of your info.

Sub AllFiles()
    Dim folderPath As String
    Dim filename As String
    Dim wb As Workbook
  
    folderPath = "C:\SAP Imports\Sales Orders\" 'change to suit
    
    If Right(folderPath, 1) <> "\" Then folderPath = folderPath + "\"
    
    filename = Dir(folderPath & "*.ped")
    Do While filename <> ""
      Application.ScreenUpdating = False
        Set wb = Workbooks.Open(folderPath & filename)
         
        'Call a subroutine here to operate on the just-opened workbook
        Call 'name of your other macro here
        
        filename = Dir
    Loop
  Application.ScreenUpdating = True
End Sub

 

[Domenic]

The following macro will loop through files within each folder and subfolder within the main folder. Note that it doesn't loop through files within the main folder itself, if any exist. If you'd like it to do so, post back. Otherwise, place the following code in a regular module, and run 'Macro1'...

Sub Macro1()
    [COLOR="SeaGreen"]'//Change the path to the main folder, accordingly[/COLOR]
    Call RecursiveFolders("C:\Path")
End Sub

Sub RecursiveFolders(ByVal MyPath As String)

    Dim FileSys As Object
    Dim objFolder As Object
    Dim objSubFolder As Object
    Dim objFile As Object
    Dim wkbOpen As Workbook
    
    Set FileSys = CreateObject("Scripting.FileSystemObject")
    Set objFolder = FileSys.GetFolder(MyPath)

    Application.ScreenUpdating = False
    
    For Each objSubFolder In objFolder.SubFolders
        For Each objFile In objSubFolder.Files
            Set wkbOpen = Workbooks.Open(Filename:=objFile)
            [COLOR="SeaGreen"]'//Change the name of your macro, accordingly[/COLOR]
            Call Macro2
            wkbOpen.Close savechanges:=True
        Next
        Call RecursiveFolders(objSubFolder.Path)
    Next

    Application.ScreenUpdating = True
    
End Sub

 

[danielpuccini]

Both work perfectly. THANK YOU!!

 

[kenman]

Daniel,

just a thought, but you might want to time both ways to see if one is faster than the other...i don't know which is, or if there is a markable difference, but if i come up with 2 solutions for the same effect, i usually test just to see.

quick way someone showed me from the forum is to put these lines near the top

dim t
t = timer


'your code


'then at the bottom put

MsgBox Round(Timer - t, 2) / 60 & " min:sec."

compare the 2 times you come up with to see if if one is faster

kenman

good luck with the program..

 

[Domenic]

Please note, though, that the first one loops through files within a single folder, whereas the second one loops through files in all folders and subfolders within a main folder.

 

[danielpuccini]

One more question: At current, the macro runs through all folders (or subfolders) and runs the macro on all file types (including my text files). How do I specify that I only want it to run the macro on the .xslm files? thanks in advance.

 

[kenman]

if using the top one, i believe if you just change the *.ped to *.xslm would do it, or whatever extension your current version of excel is..(i am still working with 2003 and only have .xls files).......regarding the second macro that runs through subfolders, not sure how that would be done...would think it would be similar, but not sure where you would put it..

kenman

 

[Domenic]

For the second one, try replacing...

    For Each objSubFolder In objFolder.SubFolders
        For Each objFile In objSubFolder.Files
            Set wkbOpen = Workbooks.Open(Filename:=objFile)
            '//Change the name of your macro, accordingly
            Call Macro2
            wkbOpen.Close savechanges:=True
        Next
        Call RecursiveFolders(objSubFolder.Path)
    Next

with

    For Each objSubFolder In objFolder.SubFolders
        For Each objFile In objSubFolder.Files
            If objFile.Type = "Microsoft Excel Macro-Enabled Worksheet" Then
                'Do stuff here
            End If
        Next
        Call RecursiveFolders(objSubFolder.Path)
    Next