Откройте файл в подпапке

Question

У меня есть файл с именем AT5321.xlsx (это имя будет продолжать изменяться), откуда я хочу вызвать макрос, который будет:

1. Перейти по адресу: C:\Atul\Data

2. Поиск папки, имя которой совпадает с именем исходного файла (например, AT5321).Фактическое имя папки выглядит следующим образом: F-003-106-AT5321.M

3. Теперь, после открытия указанной подпапки, в ней есть файл с именем report.xls, который необходимо открыть.

4. Остановите макрос

Как вы, должно быть, поняли, я новичок.Я хочу облегчить свои повседневные задачи в Excel.

Любая небольшая помощь будет очень полезна для меня.

Answer 1

С помощью сообщения Cor_Blimey .. ( Цикл по всем подпапкам с использованием VBA )

Это будет перебирать все подпапки и подпапки в подпапках (теоретически до бесконечности) ..

Public Sub NonRecursiveMethod()
Dim fso, oFolder, oSubfolder, oFile, queue As Collection
Dim FoundFolder as Boolean

Set fso = CreateObject("Scripting.FileSystemObject")
Set queue = New Collection
queue.Add fso.GetFolder("C:\Atul\Data")

Do While queue.Count > 0
    Set oFolder = queue(1)
    queue.Remove 1 'dequeue

    For Each oSubfolder In oFolder.SubFolders
        queue.Add oSubfolder
        If oSubfolder Like "*" & ThisWorkbook.Name & "*" Then 'Replace workbook name if necessary
            Workbooks.Open Filename:=oSubfolder & "\report.xls"
            FoundFolder = True
            Exit For
        End If
    Next oSubfolder
Loop

If FoundFolder = False Then MsgBox "Error: Folder '" & ThisWorkbook.Name & "' could not be found", vbExclamation, "Error"
End Sub

Кроме того, вы можете посмотреть в подпапках только из основной папки

Sub SubFoldersinMainFolder()
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder("C:\Atul\Data")
Set subfolders = folder.subfolders

For Each subfolders In subfolders

    If subfolders Like "*" & ThisWorkbook.Name & "*" Then 'Replace workbook name if necessary
        Workbooks.Open Filename:= subfolders & "\report.xls"
        FoundFolder = True
        Exit For
    End If

Next subfolders
If FoundFolder = False Then MsgBox "Error: Folder '" & ThisWorkbook.Name & "' could not be found", vbExclamation, "Error"

End Sub

Я должен добавить, что слово "папка" начинает выглядеть очень странно сейчас