VBAsearchclosures工作簿的价值？
我正在尝试search一个文件夹（和子文件夹）中的所有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
每个工作簿中的范围应始终保持不变。
我正在尝试一些简单的事情，比如在find值的时候显示一条消息。 但目前，尽pipe工作簿中存在的价值，我没有得到任何结果/没有消息。
在这一行我得到一个对象所需的错误：
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
期望的结果
你的代码设置的方式将无法正常工作。 您不能使用带有通配符的Workbooks.Open()方法，因为它一次只能打开一个文件，不会search文件。 有两种方法通过目录search具有特定命名模式的文件，我知道。 最简单的方法是使用Dir()函数，但是这不会轻易recursion到子文件夹中。
第二种方法（下面为您编码）是通过使用FileSystemObject的文件和子文件夹进行recursion的一种方式。 为了使用它，您需要将对项目的引用添加到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