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