Как добавить цикл для перехода по папкам к этому коду?

Question

, глядя на код других людей и изменить его, мне удалось собрать воедино этот кусок кода:

Sub LookForNew() 
Dim n As String, msg As String, d As Date 
msg = "" 
Set fso = CreateObject("Scripting.FileSystemObject") 
Set fils = fso.GetFolder(Range("B4")).Files 
For Each fil In fils 
    n = fil.Name 
    d = fil.DateCreated 
    If d >= Range("E1") Then 
     msg = msg & n & vbTab & d & vbCrLf 
     Range("C4") = Range("B1") 
    End If 
Next fil 
If msg = "" Then 
    MsgBox "No new files" 
    Range("C4") = Range("B1") 
Else 
    MsgBox msg 
End If 
Set fso = Nothing 
End Sub 

Это перебирает файлы в папке (путь в «В4»). Если есть фильтры, более новые, чем дата, указанная в «E1», она возвращает предупреждение.

То, что я хотел бы добавить к этому, представляет собой цикл, который проходит через все пути к папкам, заданные в диапазоне «B4: B22», и повторяет вышеуказанные действия для каждого файла в этих папках. До сих пор я столкнулся с ошибками ...

Answer 1

Если я правильно понял ваш вопрос, я бы просто обернул необходимые действия в Do Until, где строка увеличивалась на 1 на каждой итерации.

Очевидно, что если диапазон «B4: B22» изменится, это можно сделать умнее.

Private Sub LookForNew() 
Dim n As String, msg As String, d As Date 
msg = "" 
rownum = 3 
Set fso = CreateObject("Scripting.FileSystemObject") 

Do Until rownum = 24 
rownum = rownum + 1 
Set fils = fso.GetFolder(Range("B" & rownum)).Files 
    For Each fil In fils 
     n = fil.Name 
     d = fil.DateCreated 
     If d >= Range("E1") Then 
      msg = msg & n & vbTab & d & vbCrLf 
      Range("C4") = Range("B1") 
     End If 
    Next fil 

    If msg = "" Then 
     MsgBox "No new files" 
     Range("C4") = Range("B1") 
    Else 
     MsgBox (msg) 
    End If 

    'Set fso = Nothing 
Loop 

End Sub