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

这就是我更改代码的方式（请注意，您应该在代码末尾设置＆＃34;对象＆＃34;没有。）

请注意，我只使用了一个简单的＆＃34; If＆＃34;声明与＆＃34; InStr＆＃34;尝试捕获与您的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

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

1 个答案: