Hi,

I have a marco set to run and pull some information from a series of workbooks (Which I was generously help out with in the thread below, thanks to Doc.AElstein). I have come across an issue with the structure of the folders in which the workbooks are kept, and need the macro to look in all subfolders for the files that I am after.

Post to create original macro:
http://www.excelforum.com/excel-prog...ml#post4208224

Code for Macro:
Sub Code4OpenCloseAllFilesIfChangedSinceLastTime()

' Date Stamp info
Dim DateLastModified As String 'This is the Date shown as last time file was saved.
Dim DateStamp As String  'This represents the Date this macro last ran and

' Workbooks Info.
Dim WB As Workbook, ws As Worksheet 'Variables used for temproary holding of File and sheet in each File looked at in Cressie Folder
Dim ws1 As Worksheet: Set ws1 = ThisWorkbook.Worksheets("Sheet1") 'Sheet where date stamp is
Dim strFileName As String, FullFilePathAndName As String 'Variables for File Name and full Path Link to File
Dim strDefPath As String: Let strDefPath = "S:\NJR\SEC\MC\Test" 'Any Path / Folder to test this code! here we simply use the Path where the File with this code in is
Dim FileSystem As Object
Dim HostFolder As String




    
If Right(strDefPath, 1) <> "\" Then strDefPath = strDefPath & "\" 'Good check as this is sometimes forgotten
Debug.Print strDefPath 'Displaying the string in the Immediate Window (Ctrl-G in the VB Editor) can help to check correct format
            'Initial ( First ) File in Folder
            Let strFileName = Dir("" & strDefPath & "") 'Gives next ( Any type  ) File in strDefPath Folder
Dim strExt As String 'Used to narrow down Files to specific type
Let strExt = "xls":
Dim strSearchForDir As String: Let strSearchForDir = strDefPath & "*." & strExt
Debug.Print strSearchForDir
Let strFileName = Dir("" & strSearchForDir & "") ' To be a bit more selective
Debug.Print strFileName '

Let DateStamp = ws1.Cells(1, 1).Value 'Date stamp in first cell of master File to indicate whan this macro last ran
    'Main loop For each file in folder while...
    While strFileName <> "" 'Dir will return this once it has gone through every file of Type and Folder selected in above lines
      Debug.Print strFileName
      If strFileName <> ThisWorkbook.Name Then 'Just in case this File is also in the Folder you are getting Files from
        Let FullFilePathAndName = strDefPath & strFileName
        Debug.Print FullFilePathAndName
        Let DateLastModified = CStr(Format((FileDateTime(FullFilePathAndName)), "dd/mm/yyyy"))
            
            'Check criteria for doing Stuff, then do or not
            If DateStamp = "" Or DateLastModified > DateStamp Then ' case profgram vever run  or a change since run Important to do the "" check first or the second could error due to incompatible types
            Set WB = Workbooks.Open(strDefPath & Application.PathSeparator & strFileName) 'Will not error if File already open.
            Set ws = WB.Worksheets.Item(1) 'First sheet item ( first from left tab )

           
Range("L3:W3").Copy
'If you change the above for a lot of lines, only lines with data will be pulled through

Application.DisplayAlerts = False
ActiveWorkbook.Close

erow = Sheet1.Cells(Rows.Count, 3).End(xlUp).Offset(1, 0).Row
ActiveSheet.Paste Destination:=Worksheets("Sheet1").Range(Cells(erow, 1), Cells(erow, 12)) ' Do the main stuff ( Replace this line with whatever you want to do
            
            'wb.Close SaveChanges:=True 'Option stops automatically being asked so no need for Application.DisplayAlerts = False / True pair . And we want to save or the two date alterations will not be made
            
            'Update Date Stamp after macro has dine stuff
            ws1.Cells(1, 1).Value = CStr(Format(Now(), "dd/mm/yyyy")) 'Always use this Format by everyone to be on the safe side
            ws1.Cells(1, 1).NumberFormat = "@" 'Bit of "Belt and Braces" for Excel and VBA Date change annoying characteristics
            
            Else ' case File has not been updated
            'MsgBox ("File " & strFileName & "  has not been changed since " & DateStamp & "")
            'Do no stuff so do not change date stamp
            End If
    
      Else 'case this workbook selected
      End If
      
    strFileName = Dir 'Using simple unqualified Dir goes to next File similar in type to the last in last Folder looked in ( Does the same again with the same search criteria )
    Wend
End Sub
I have found code to look in subfolders and it works with some things I have tried, however I cannot get it to work with the above macro (using Call Code4OpenCloseAllFilesIfChangedSinceLastTime in the appropriate place. I am guessing that is is something to do with either conflicting filepaths or the dir command from the original macro, but cannot work it out.

code from here:
http://answers.microsoft.com/en-us/o...32ea68e?auth=1

that works with some things to look in the subfolders, but cannot get my macro from above to work. All help greatly appreciated!

Sub AAA()
    Dim FSO As Scripting.FileSystemObject
    Dim FF As Scripting.Folder
    
    Set FSO = New Scripting.FileSystemObject
    Set FF = FSO.GetFolder("S:\NJR\SEC\MC\Test\")

    DoOneFolder FF
End Sub
Sub DoOneFolder(FF As Scripting.Folder)
    Dim F As Scripting.File
    Dim SubF As Scripting.Folder
    Dim WB As Workbook
    Dim WBname As String
    
    For Each F In FF.Files
        Set WB = Workbooks.Open(F.Path)
        
        
        Call Code4OpenCloseAllFilesIfChangedSinceLastTime
    
     
        ' do something with workbook WB here
        
        
        WB.Close
        Debug.Print F.Name
    Next F
    
    For Each SubF In FF.SubFolders
        DoOneFolder SubF
    Next SubF
End Sub