Dim startFolder

Set fso = CreateObject("Scripting.FileSystemObject")
'Место указания пути рекурсии
startFolder = "D:\1\"

CheckFolderInFolder startFolder

Function CheckFolderInFolder (AdresFolder)
    Dim File
    Set Folder = FSO.GetFolder(AdresFolder)
    Set CollectionFolder = Folder.SubFolders
    Set CollectionFile = Folder.Files

    If CollectionFile.count > 0 Then
        For Each File In CollectionFile
            ' Сообщение о файле при переборе
            MsgBox File.Path
        Next
    End If
    
    For Each SubFolder In CollectionFolder
        CheckFolderInFolder SubFolder
    Next

End Function

Dim startFolder, Files(), RazmerMassivaFiles,i,SpisokIzMassiva

RazmerMassivaFiles = 0
reDim Files(RazmerMassivaFiles)

Files(RazmerMassivaFiles) = "В данной структуре каталогов нет файлов"

Set fso = CreateObject("Scripting.FileSystemObject")
startFolder = "D:\GamesMailRu\"

CheckFolderInFolder startFolder

'Вывод значений массива
For i=0 To RazmerMassivaFiles Step 1
    SpisokIzMassiva = SpisokIzMassiva + Files(i) +vbCrLf
    i=i+1
Next

MsgBox SpisokIzMassiva

Function CheckFolderInFolder (AdresFolder)
    'MsgBox AdresFolder
    Dim File
    Set Folder = FSO.GetFolder(AdresFolder)
    Set CollectionFolder = Folder.SubFolders
    Set CollectionFile = Folder.Files
    'MsgBox CollectionFile.count
    If CollectionFile.count > 0 Then
        For Each File In CollectionFile
            Files(RazmerMassivaFiles) = File.Path
            'MsgBox "В массив Files("&RazmerMassivaFiles &") помещено значение = " 

&Files(RazmerMassivaFiles)
            RazmerMassivaFiles = RazmerMassivaFiles + 1
            reDim preserve Files(RazmerMassivaFiles)
            'Files(RazmerMassivaFiles) = "Пустое значение"
        Next
    End If
    
    For Each SubFolder In CollectionFolder
        CheckFolderInFolder SubFolder
    Next

End Function

'On Error Resume Next
Set fso = CreateObject("Scripting.FileSystemObject")
startFolder = "D:\1\" 
If fso.FolderExists (startFolder) Then Start startFolder

Function Start(folderName)
'MsgBox folderName
    Dim folder, file, fileCollection, folderCollection, subFolder, all, allmassiv
    Dim a(),i,j,k
    i=0        
    k=0
    reDim a(1,1)
    
    all = ""
    allmassiv = ""
    Set folder = fso.GetFolder(folderName)
    Set folderCollection = folder.subFolders
    For Each subFolder In folderCollection
        'MsgBox subFolder.Path
        all = all + subFolder.Path +vbCrLf
        a(i) = all
        a(k) = subFolder.DateCreated
        'MsgBox subFolder.DateCreated
        i=i+1
        k=k+1
        reDim preserve a(i,k)
        Set fileCollection = subFolder.Files   
        For Each file In fileCollection
            'MsgBox file.Path
            all = all + file.Path +vbCrLf
            a(i)=all
            i=i+1
            k=k+1
            j=i
            reDim preserve a(i,k)
        Next 
    Next
        
    MsgBox all
    k=0
    For i=0 To j Step 1
    allmassiv = a(i,k) +vbCrLf
    k=k+1
    Next
   MsgBox allmassiv
End Function

'On Error Resume Next
Set fso = CreateObject("Scripting.FileSystemObject")
startFolder = "D:\" 
If fso.FolderExists (startFolder) Then Start startFolder

Function Start(folderName)
MsgBox folderName
    Dim folder, file, fileCollection, folderCollection, subFolder, all
    all = ""
    Set folder = fso.GetFolder(folderName)
    Set folderCollection = folder.subFolders
    For Each subFolder In folderCollection
        MsgBox subFolder.Path
        all = all + subFolder.Path +vbCrLf
        Set fileCollection = subFolder.Files   
        For Each file In fileCollection
            MsgBox file.Path
            all = all + file.Path +vbCrLf
        Next 
    Next
        
    MsgBox all
   
End Function

Set fso = CreateObject("Scripting.FileSystemObject")
startFolder = "D:\1\"
OlderThanDate = DateAdd("d", -2, Date)
 
DeleteOldFiles startFolder, OlderThanDate
 
Function DeleteOldFiles(folderName, BeforeDate)
   Dim folder, file, fileCollection, folderCollection, subFolder 
   Set folder = fso.GetFolder(folderName)
   Set fileCollection = folder.Files
   For Each file In fileCollection
      If file.DateLastModified < BeforeDate Then
        MsgBox file.Path
         'fso.DeleteFile file.Path, True
      End If
   Next 
    Set folderCollection = folder.SubFolders
    For Each subFolder In folderCollection
        MsgBox subFolder.Path
       'DeleteOldFiles subFolder.Path, BeforeDate
       'If subFolder.Size = 0 Then subFolder.Delete True
    Next
End Function