查找具有指定名稱的Windows子文件夾

Question

我想遍歷文件夾（G：/ Proj）並找到名爲「SUMMARY LOG」的任何子文件夾，然後在每個文件夾內打印Excel文件（通常只有一個）。

這是在它

主文件夾（PROJ）的所有項目文件夾這是我想打印出的文件只是一個截圖。

每個項目都有一個SUMMARY LOG文件夾。

這裏是VBA代碼。它循環遍歷每個子文件夾並打印出這些文件夾中的每個Excel文件，而不僅僅是「彙總日誌」。

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

這是我如何改變你的代碼（請注意，你應該在你的代碼的結尾設置你的「對象」，沒有）。

請注意，我只是用一個簡單的「If」語句和「InStr」函數來嘗試捕捉與您的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 

UPDATE

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