Addition to VBA code to run through Sub Folders

[Bvendett4]

Hello,
Please can some adapt the below code to allow the files to run through sub folders?

Sub Example1()

Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer

Sheet2.Activate

'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")

'Get the folder object
Set objFolder = objFSO.GetFolder("G:\Shared\Health & Safety\5. Risk Assessments\1. Risk Assessments New")
i = 1

'loops through each file in the directory
For Each objFile In objFolder.Files
    'create hyperlink in appropriate cell
    ActiveSheet.Hyperlinks.Add Anchor:=ActiveSheet.Cells(i + 1, 2), Address:=objFile.Path, TextToDisplay:=objFile.Name
    'add date created to the right
    ActiveSheet.Cells(i + 1, 3).Value = objFile.DateLastModified
    i = i + 1
Next objFile

End Sub

Many Thanks

 

[Fluff]

Have a look here https://www.mrexcel.com/forum/excel-questions/866125-vba-loop-through-all-files-all-subfolders.html

 

[Bvendett4]

Hello,
Please accept my apologies but I cannot see the part that will help me, I am very much a beginner in VBA and the above code was already in place.
There have been sub folders added to the the original files and unfortunately these cannot be eliminated from the equation, therefore the code needs adapting.

Any further help would be appreciated.

Many Thanks

 

[Fluff]

Try

Sub LopFolder()


   Dim fso As FileSystemObject
   Dim f As folder, sf As folder
   Dim ofile As File
   Dim MyPath As String, MyFile As String, File As Workbook
   Dim i As Long
   
   i = 1
   Set fso = CreateObject("Scripting.FileSystemObject")
   Set f = fso.getfolder("G:\Shared\Health & Safety\5. Risk Assessments\1. Risk Assessments New")
   For Each ofile In f.Files
      ActiveSheet.Hyperlinks.Add Anchor:=ActiveSheet.Cells(i + 1, 2), Address:=ofile.Path, TextToDisplay:=ofile.Name
      ActiveSheet.Cells(i + 1, 3).Value = ofile.DateLastModified
      i = i + 1
   Next ofile
   For Each sf In f.subfolders
      For Each ofile In sf.Files
         ActiveSheet.Hyperlinks.Add Anchor:=ActiveSheet.Cells(i + 1, 2), Address:=ofile.Path, TextToDisplay:=ofile.Name
         ActiveSheet.Cells(i + 1, 3).Value = ofile.DateLastModified
         i = i + 1
      Next ofile
   Next sf


End Sub