VBA搜索已關閉的工作簿以獲取價值？

Question

我正在嘗試搜索文件夾（和子文件夾）中的所有excel工作簿以獲取值。

我的文件夾結構，在我的Excel工作簿的是，像這樣：

destPath = "G:\WH DISPO\(3) PROMOTIONS\(18) Food Specials Delivery Tracking\Archive\" 

然後我的存檔文件夾內有各種各樣的子文件夾像

+ 2017 
- April 
- May 

+ 2016 
- April 
- May 

工作簿的名稱可能都不同，所以代碼將需要可能使用通配符* .xlsm

這是我到目前爲止：

Sub Search() 
Dim srcWorkbook As Workbook 
    Dim destWorkbook As Workbook 
    Dim srcWorksheet As Worksheet 
    Dim destWorksheet As Worksheet 
    Dim SearchRange As Range 
    Dim destPath As String 
    Dim destname As String 
    Dim destsheet As String 
    Set srcWorkbook = ActiveWorkbook 
    Set srcWorksheet = ActiveSheet 
    Dim vnt_Input As String 

    vnt_Input = Application.InputBox("Please Enter Client Name", "Client Name") 

    destPath = "G:\WH DISPO\(3) PROMOTIONS\(18) Food Specials Delivery Tracking\Archive\" 
    destname = "*.xlsm" 


    On Error Resume Next 
    Set destWorkbook = ThisWorkbook 
    If Err.Number <> 0 Then 
    Err.Clear 
    Set wbTarget = Workbooks.Open(destPath & destname) 
    CloseIt = True 
    End If 

    For Each c In wbTarget.Sheets(1).Range("A:Q") 'No need for the .Cells here 

     If InStr(c, vnt_Input) > 0 Then 'vnt_Input is a variable that holds a string, so you can't put quotes around it, or it will search the string for "vnt_Input" 

      MsgBox "Found" 
     End If 
    Next c 

End Sub 

每個工作簿中的範圍應始終保持不變。

我在嘗試一些簡單的事情，比如在找到值時顯示一條消息。但目前，儘管工作簿中存在價值，但我得不到任何結果/消息。

我在這條線得到一個對象所需的錯誤：

For Each c In wbTarget.Sheets(1).Range("A:Q") 'No need for the .Cells here 

請能有人告訴我在哪裏，我錯了？

編輯：

我可以改變消息框的每個循環列出每個結果像這樣：

Dim i As Integer 
For i = 20 To 100 

For Each rngFound In rngFound 

ThisWorkbook.ActiveSheet.Range("E" & i).Value = "1 Result found for " & rngFound & " in " & wbTarget.Path & "\" & wbTarget.Name & ", on row " & rngFound.Address 

Next rngFound 

Next i 

所需的結果

Answer 1

的方式代碼設置不起作用。您不能將Workbooks.Open()方法與通配符一起使用，因爲它一次只能打開一個文件，並且不會搜索文件。有兩種方法通過目錄搜索具有特定命名模式的文件，我知道它。最簡單的方法是使用Dir()函數，但這不會輕易遞歸到子文件夾中。

第二種方法（下面爲您編碼）是通過使用FileSystemObject的文件和子文件夾進行遞歸的一種方式。爲了使用它，您需要將對項目的引用添加到Microsoft Scripting Runtime庫。您可以通過工具 - >參考添加參考。

另請注意，此方法使用Range.Find()方法在工作簿中查找客戶端名稱，因爲它比當前查找客戶端名稱是否在工作表中的方法更快，更易於理解。

Option Explicit 

Sub Search() 

Dim myFolder As Folder 
Dim fso As FileSystemObject 
Dim destPath As String 
Dim myClient As String 

myClient = Application.InputBox("Please Enter Client Name", "Client Name") 

Set fso = New FileSystemObject 

destPath = "G:\WH DISPO\(3) PROMOTIONS\(18) Food Specials Delivery Tracking\Archive\" 

Set myFolder = fso.GetFolder(destPath) 

'Set extension as you would like 
Call RecurseSubfolders(myFolder, ".xlsm", myClient) 

End Sub 

---

Sub RecurseSubfolders(ByRef FolderToSearch As Folder, _ 
      ByVal fileExtension As String, ByVal myClient As String) 

Dim fileCount As Integer, folderCount As Integer 
Dim objFile As File 
Dim objSubfolder As Folder 

fileCount = FolderToSearch.Files.Count 
'Loop over all files in the folder, and check the file extension 
If fileCount > 0 Then 
    For Each objFile In FolderToSearch.Files 
    If LCase(Right(objFile.Path, Len(fileExtension))) = LCase(fileExtension) Then 
     'You can check against "objFile.Type" instead of the extension string, 
     'but you would need to check what the file type to seach for is 
     Call LookForClient(objFile.Path, myClient) 
    End If 
    Next objFile 
End If 

folderCount = FolderToSearch.SubFolders.Count 
'Loop over all subfolders within the folder, and recursively call this sub 
If folderCount > 0 Then 
    For Each objSubfolder In FolderToSearch.SubFolders 
    Call RecurseSubfolders(objSubfolder, fileExtension, myClient) 
    Next objSubfolder 
End If 

End Sub 

---

Sub LookForClient(ByVal sFilePath As String, ByVal myClient As String) 

Dim wbTarget As Workbook 
Dim ws As Worksheet 
Dim rngFound As Range 
Dim firstAddress As String 
Static i As Long   'Static ensures it remembers the value over subsequent calls 

'Set to whatever value you want 
If i <= 0 Then i = 20 

Set wbTarget = Workbooks.Open(Filename:=sFilePath) 'Set any other workbook opening variables as appropriate 

'Loop over all worksheets in the target workbook looking for myClient 
For Each ws In wbTarget.Worksheets 
    With ws.Range("A:Q") 
    Set rngFound = .Find(What:=myClient, LookIn:=xlValues, LookAt:=xlPart) 

    If Not rngFound Is Nothing Then 
     firstAddress = rngFound.Address 

     'Loop finds all instances of myClient in the range A:Q 
     Do 
     'Reference the appropriate output worksheet fully, don't use ActiveWorksheet 
     ThisWorkbook.Worksheets("SomeSheet").Range("E" & i).Value = _ 
        "1 Result found for " & myClient & " in " & sFilePath _ 
        & ", in sheet " & ws.Name & ", in cell " & rngFound.Address 
     i = i + 1 
     Set rngFound = .FindNext(After:=rngFound) 
     Loop While (Not rngFound Is Nothing And rngFound.Address <> firstAddress) 
    End If 
    End With 
Next ws 

'Close the workbook 
wbTarget.Close SaveChanges:=False 

End Sub