Run a macro on all folders and subfolders

[pammesue]

I have searched here and tried about 50 different variations of "almost" what I am looking for but I cant get anything to work!

I already have a macro that is adding a picture for a watermark. It opens the workbook, adds the picture, and saves the workbook.

I want to run this macro on all workbooks in folders as well as the workbooks in the subfolders.

I get it to work on the workbooks that are loose in the folder but not the subfolders. AND i can only get it to run if i am in debug and step into then hit play. Its been 3 days and Im sooooo over it. Can anyone help me

code
Sub watermarkopenfiles()
'
' watermarkopenfiles Macro
'


'
ActiveSheet.Pictures.Insert( _
"C:\Users\sgtepkent\Desktop\OBSOLETE WATERMARK.png").Select
Selection.ShapeRange.IncrementLeft 33.6
Selection.ShapeRange.IncrementTop -321.6
ActiveWorkbook.Save
ActiveWorkbook.Close
End Sub




Sub LoopThroughFiles()

FolderName = "W:\Flex-Tek\SGTE\Portland Gastite\Quality\Inspection Plans\Periodic Inspection Plans\OBSOLETE IP'S\acc solar bracket assembly"
If Right(FolderName, 1) <> Application.PathSeparator Then FolderName = FolderName & Application.PathSeparator
Fname = Dir(FolderName & "*.xls")


'loop through the files
Do While Len(Fname)


With Workbooks.Open(FolderName & Fname)


' here comes the code for the operations on every file the code finds


'HERE if you want to execute the second macro for every file in the loop
watermarkopenfiles


End With


' go to the next file in the folder
Fname = Dir


Loop

End Sub

 

[pammesue]

Sub watermarkopenfiles()
'
' watermarkopenfiles Macro
'


'
    ActiveSheet.Pictures.Insert( _
        "C:\Users\sgtepkent\Desktop\OBSOLETE WATERMARK.png").Select
    Selection.ShapeRange.IncrementLeft 33.6
    Selection.ShapeRange.IncrementTop -321.6
    ActiveWorkbook.Save
    ActiveWorkbook.Close
End Sub




Sub LoopThroughFiles()
    
    FolderName = "W:\Flex-Tek\SGTE\Portland Gastite\Quality\Inspection Plans\Periodic Inspection Plans\OBSOLETE IP'S\acc solar bracket assembly"
    If Right(FolderName, 1) <> Application.PathSeparator Then FolderName = FolderName & Application.PathSeparator
    Fname = Dir(FolderName & "*.xls")


    'loop through the files
    Do While Len(Fname)


        With Workbooks.Open(FolderName & Fname)


           ' here comes the code for the operations on every file the code finds


           'HERE if you want to execute the second macro for every file in the loop
           watermarkopenfiles


        End With


        ' go to the next file in the folder
        Fname = Dir


    Loop
    
End Sub[/QUOTE]

 

[John_w]

The code at https://www.mrexcel.com/forum/excel...older-sub-folder-post4624844.html#post4624844 loops through and opens all .xls files in all subfolders starting at a specified main folder. It currently adds a new sheet to each workbook, so see if you can adapt it for your case.

 

[VBA Geek]

Try this, running the sub AllFiles

[FONT=Courier]Const RootFolder As String = "W:\Flex-Tek\SGTE\Portland Gastite\Quality\Inspection Plans\Periodic Inspection Plans\OBSOLETE IP'S\acc solar bracket assembly\"
Private FSO As Scripting.FileSystemObject


Sub AllFiles()

Set FSO = CreateObject("Scripting.FileSystemObject")

DrillFolder RootFolder

Set FSO = Nothing
End Sub


Private Sub DrillFolder(fPath As String)
Dim oFile           As Scripting.File
Dim oFldr           As Scripting.Folder

For Each oFile In FSO.GetFolder(fPath).Files
    If UCase(oFile.Name) Like "*.XLS" Then
        watermarkopenfiles filePath:=oFile.Path
    End If
Next

For Each oFldr In FSO.GetFolder(fPath).SubFolders
    DrillFolder oFldr.Path
Next oFldr
End Sub

Private Sub watermarkopenfiles(filePath As String)
Dim W As Workbook, S As Worksheet
Set W = Workbooks.Open(filePath, , False)
Set S = ActiveSheet
S.Pictures.Insert( _
"C:\Users\sgtepkent\Desktop\OBSOLETE WATERMARK.png").Select
Selection.ShapeRange.IncrementLeft 33.6
Selection.ShapeRange.IncrementTop -321.6
W.Close savechanges:=True
End Sub[COLOR=#00007F][/COLOR]
[/FONT]

 

[pammesue]

I seriously dont know where to call my macro. I took out all the stuff about making a new sheet and then it only works on the personal.xlsb workbook and the open excel workbook.

Sub watermarkopenfiles()
'
' watermarkopenfiles Macro
'


'
    ActiveSheet.Pictures.Insert( _
        "C:\Users\sgtepkent\Desktop\OBSOLETE WATERMARK.png").Select
    Selection.ShapeRange.IncrementLeft 33.6
    Selection.ShapeRange.IncrementTop -321.6
    ActiveWorkbook.Save
    ActiveWorkbook.Close
End Sub




Public Sub Add_Master_Sheet_To_All_Workbooks_All_Subfolders_LB()
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    Process_Workbooks_In_Folder "W:\Flex-Tek\SGTE\Portland Gastite\Quality\Inspection Plans\Periodic Inspection Plans\OBSOLETE IP'S\"
    
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    
    MsgBox "Done"
    
End Sub




Private Sub Process_Workbooks_In_Folder(folderPath As String)
   
    Static FSO As Object
    Dim Folder As Object, Subfolder As Object, File As Object
    
    If FSO Is Nothing Then Set FSO = CreateObject("Scripting.FileSystemObject")


    'Process files in this folder
    
    Set Folder = FSO.GetFolder(folderPath)
    
    For Each File In Folder.Files
        If File.Name Like "*.xls" Then
            Call watermarkopenfiles
        End If
    Next
    
    'Process files in subfolders
    
    For Each Subfolder In Folder.SubFolders
        Process_Workbooks_In_Folder Subfolder.path
    Next


End Sub

The code at https://www.mrexcel.com/forum/excel...older-sub-folder-post4624844.html#post4624844 loops through and opens all .xls files in all subfolders starting at a specified main folder. It currently adds a new sheet to each workbook, so see if you can adapt it for your case.

 

[pammesue]

hey this seems to work, however i had to delete all of my other macros! thanks