MyPath = "D:\Документы\Отчеты\"
MyName = Dir(MyPath, vbDirectory) ' - открываем папку

Do While MyName <> ""
If MyName <> "." And MyName <> ".." Then
If (GetAttr(MyPath & MyName) And vbDirectory) = vbDirectory Then

fileName = Dir(MyPath & MyName & "\*.xls") ' - перебираем Excel-файлы
Do While fileName <> ""
fileName = Dir
Loop
' - а дальше необходимо перейти в следующую папку с Excel-файлами, но вместо этого
' вылетаю из Do ... Loop
MyName = Dir(MyPath & MyName, vbDirectory)
End If
End If

MyName = Dir
Loop