Open worksheets and run macro in a specified folder

[shockmoorthy]

Dears,
I am looking for macro command to open all worksheets in a specified folder and run certain commands save and close file.

 

[Trebor76]

Hi there,

Try this - you will just need to change the strPath variable and put your own code where I've put the comment "Your code here" (assuming you want the code to run on every tab of the workbook):

Option Explicit
Sub Macro1()

    Dim strPath As String
    Dim strFileName As String
    Dim wb As Workbook
    Dim ws As Worksheet
    
    Application.ScreenUpdating = False
    
    strPath = "H:\" 'Directory path containing Excel files. Change to suit.
    If Right(strPath, 1) <> "\" Then
        strPath = strPath & "\"
    End If
    strFileName = Dir(strPath & "*.xls*")

    Do While Len(strFileName) > 0
        Set wb = Workbooks.Open(strPath & strFileName)
        For Each ws In wb.Worksheets
            ws.Activate
            'Your code here
        Next ws
        wb.Close SaveChanges:=True
        Set wb = Nothing
        strFileName = Dir
    Loop
    
    Application.ScreenUpdating = True

End Sub

Regards,

Robert

 

[shockmoorthy]

Dear Robert,
Thanks for the reply. Your code is working fine. But only thing, its not opening sub folder files. Can you please help on this.
For example I have given strPath = "Z:\Thirumoorthy\test" there are many sub folders under this directory in the sub folders only have files, each folders contains three are four xlsx files.

 

[Trebor76]

I have adapted the following code from this nifty non-recursive example:

Option Explicit
Sub Macro2()
    
    Dim objFSO As Object
    Dim objFolder As Object
    Dim objSubfolder As Object
    Dim objFile As Object
    Dim clnQueue As Collection
    Dim strPath As String
    Dim wb As Workbook
    Dim ws As Worksheet
    
    Application.ScreenUpdating = False
    
    strPath = "Z:\Thirumoorthy\test\" 'Directory path containing Excel files. Change to suit.
    If Right(strPath, 1) <> "\" Then
        strPath = strPath & "\"
    End If

    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set clnQueue = New Collection
    clnQueue.Add objFSO.GetFolder(strPath)
        
    Do While clnQueue.Count > 0
        Set objFolder = clnQueue(1)
        clnQueue.Remove 1
        For Each objSubfolder In objFolder.SubFolders
            clnQueue.Add objSubfolder
        Next objSubfolder
        For Each objFile In objFolder.Files
            If InStr(objFSO.GetExtensionName(objFile.Name), "xls") > 0 Then
                Set wb = Workbooks.Open(objFolder.Path & "\" & objFile.Name)
                For Each ws In wb.Worksheets
                    ws.Activate
                    'Your code here
                Next ws
                wb.Close SaveChanges:=True
                Set wb = Nothing
            End If
        Next objFile
    Loop
    
    Application.ScreenUpdating = True

End Sub

Just ensure the strPath variable is correct and put your own code where I've put the comment "Your code here" (assuming you want the code to run on every tab of the workbook).

Regards,

Robert

 

[shockmoorthy]

Thank you so very much Mr. Robert. Your are awesome, your 100% perfect man. Its working dude. You made my work very simple.

 

[Trebor76]

Thanks for letting us know and I'm glad we were able to provide you with a working solution