查找具有指定名称的 Windows 子文件夹

Question

我想遍历一个文件夹 (G:/Proj) 并找到任何名为“SUMMARY LOG”的子文件夹，然后在每个文件夹中打印 Excel 文件，通常只有一个。

这是包含所有项目文件夹的主文件夹 (Proj)

这只是我要打印的文件之一的屏幕截图。

每个项目都有一个 Summary LOG 文件夹。

这是 VBA 代码。它遍历每个子文件夹并打印出这些文件夹中的每个 Excel 文件，而不仅仅是“SUMMARY LOG”。

Sub LoopFolders()
    Dim strFolder As String
    Dim strSubFolder As String
    Dim strFile As String
    Dim colSubFolders As New Collection
    Dim varItem As Variant
    Dim wbk As Workbook
    ' Parent folder including trailing backslash
    strFolder = "G:/Proj/"
    ' Loop through the subfolders and fill Collection object
    strSubFolder = Dir(strFolder & "*", vbDirectory)
    Do While Not strSubFolder = ""
        Select Case strSubFolder
            Case ".", ".."
                ' Current folder or parent folder - ignore

            Case Else
                ' Add to collection
                colSubFolders.Add Item:=strSubFolder, Key:=strSubFolder
        End Select
        ' On to the next one
        strSubFolder = Dir
    Loop
    ' Loop through the collection
    For Each varItem In colSubFolders
        ' Loop through Excel workbooks in subfolder
        strFile = Dir(strFolder & varItem & "\*.xls*")
        Do While strFile <> ""
            ' Open workbook
            Set wbk = Workbooks.Open(Filename:=strFolder & _
                varItem & "\" & strFile, AddToMRU:=False)
            ' Do something with the workbook
            ActiveSheet.PrintOut
            ' Close it
            wbk.Close SaveChanges:=False
            strFile = Dir
        Loop
    Next varItem
End Sub

Answer 1

这就是我更改代码的方式（请注意，您应该在代码末尾将“对象”设置为空）。

请注意，我只是使用带有“InStr”函数的简单“If”语句来尝试捕捉与您的 Excel 工作簿相关的流行语。这是我的模拟文件夹的样子： Simulated Folder with File Names

Sub LoopFolders()
Dim strFolder As String
Dim strSubFolder As String
Dim strFile As String
Dim colSubFolders As New Collection
Dim varItem As Variant
Dim wbk As Workbook
' Parent folder including trailing backslash
strFolder = "C:\Users\anm2mip\Desktop\Exp\"
' Loop through the subfolders and fill Collection object
strSubFolder = Dir(strFolder & "*", vbDirectory)
Do While Not strSubFolder = ""
    Select Case strSubFolder
        Case ".", ".."
        ' Current folder or parent folder - ignore

        Case Else
            ' Add to collection
            colSubFolders.Add Item:=strSubFolder, Key:=strSubFolder
    End Select
    ' On to the next one
    strSubFolder = Dir
Loop
' Loop through the collection
For Each varItem In colSubFolders
    ' Loop through Excel workbooks in subfolder
    strFile = Dir(strFolder & varItem & "\*.xls*") 'never mind the .xlsx, I forgot that the * symbol is wildcard.
    Do While strFile <> ""
         If InStr(strFile, "Summary") And InStr(strFile, "Log") Then
             ' Open workbook
             Set wbk = Workbooks.Open(FileName:=strFolder & _
             varItem & "\" & strFile, AddToMRU:=False)
             ' Do something with the workbook
             MsgBox strFile
             ' ActiveSheet.PrintOut
             ' Close it
             wbk.Close SaveChanges:=False
         End If
         strFile = Dir
      Loop
Next varItem

Set colSubFolders = Nothing
Set varItem = Nothing
Set wbk = Nothing
End Sub

更新

Test Folder Structure 请注意，我还在那里扔了几个不同的 excel 文件类型和一个 word 文档，下面的代码过滤掉了除我指定的 excel 文件类型之外的所有文件。

我将此答案用作参考：Recursive drill down into folders example。感谢用户 @Cor_Blimey 提供易于使用的帖子。

Sub LoopFolders()
Dim fso, oFolder, oSubfolder, oFile, queue As Collection
Dim colFiles As New Collection
Dim wbk As Workbook

Set fso = CreateObject("Scripting.FileSystemObject")
Set queue = New Collection
queue.Add fso.GetFolder("C:\Users\anm2mip\Desktop\Exp\")

' Parent folder including trailing backslash
'strFolder = "C:\Users\anm2mip\Desktop\Exp\"

Do While queue.Count > 0
    Set oFolder = queue(1)
    queue.Remove 1 'dequeue
    For Each oSubfolder In oFolder.SubFolders
        queue.Add oSubfolder
    Next oSubfolder
    'Filter subfolders here
    If InStr(oFolder.Name, "Summary") And InStr(oFolder.Name, "Log") Then
        For Each oFile In oFolder.Files
            'You can filter files here with an if...then statement
            If oFile.Type = "Microsoft Excel Worksheet" Or _
            oFile.Type = "Microsoft Excel 97-2003 Worksheet" Or _
            oFile.Type = "Microsoft Excel Macro-Enabled Worksheet" Then
                colFiles.Add Item:=oFile, Key:=oFile.Name
        Next oFile
    End If
Loop

MsgBox "Number of files held in Summary Log folders is: " & colFiles.Count
For Each oFile In colFiles
    Set wbk = Workbooks.Open(FileName:=oFile.Path, AddtoMRU:=False)
    MsgBox oFile.Name
    'Do your printing operation here.
    wbk.Close SaveChanges:=False
Next oFile

Set fso = Nothing
Set oFolder = Nothing
Set oSubfolder = Nothing
Set oFile = Nothing
Set queue = Nothing
Set wbk = Nothing
End Sub