VBA – search目录中的所有excel工作簿以获取特定的值。 如果find值，列出工作簿文件path？

我正在使用下面的代码来search目录中的所有Excel工作簿，并列出所有匹配值及其单元格引用和每个工作簿中find匹配的值。

这几乎工作。 但是，而不是工作簿名称，它给了我的工作表名称。

我想列出工作簿名称，也想列出工作簿文件path。 在几列中。

我试图通过添加以下行来做到这一点：

ThisWorkbook.ActiveSheet.Range("P" & i).Value = Application.Workbooks(rngFound.Parent).Path 

但是这会产生types不匹配错误。

我也试过：

  ThisWorkbook.ActiveSheet.Range("P" & i).Value = rngFound.Parent.FullName 

没有任何运气。

请有人告诉我我要去哪里错了吗？

完整代码：

 Option Explicit Sub Search() Dim myFolder As Folder Dim fso As FileSystemObject Dim destPath As String Dim myClient As String myClient = ThisWorkbook.ActiveSheet.Range("J10").Value If myClient = "" Then Exit Sub 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 app As New Excel.Application app.Visible = False 'Visible is False by default, so this isn't necessary Application.ScreenUpdating = False Application.DisplayAlerts = False Application.EnableEvents = False 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) Application.ScreenUpdating = False Application.DisplayAlerts = False Application.EnableEvents = False 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.ActiveSheet.Range("E" & i).Value = myClient ThisWorkbook.ActiveSheet.Range("H" & i).Value = rngFound.Address ThisWorkbook.ActiveSheet.Range("L" & i).Value = rngFound.Parent.Name ThisWorkbook.ActiveSheet.Range("P" & i).Value = Application.Workbooks(rngFound.Parent).Path 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 Application.ScreenUpdating = True Application.DisplayAlerts = True Application.EnableEvents = True End Sub Sub Clear() Application.ScreenUpdating = False Application.DisplayAlerts = False Application.EnableEvents = False ThisWorkbook.ActiveSheet.Range("E20:Y100").ClearContents Application.ScreenUpdating = True Application.DisplayAlerts = True Application.EnableEvents = True End Sub 

Answer 1

范围的父级是工作表。 工作表的父母是工作簿。

为什么不试试.Parent两次：

 ThisWorkbook.ActiveSheet.Range("P" & i).Value = _ rngFound.Parent.Parent.Path ' or .FullName or anything from the WB ' ^^^^^^^^^^^^^ 

Answer 2

一般来说，select一个单元格并写下以下内容：

 Public Sub GiveMeInformation() 'Sheet name Debug.Print Selection.Parent.name 'Workbook name Debug.Print Selection.Parent.Parent.name 'Workbook path Debug.Print Selection.Parent.Parent.Path 'Workbook path + the workbook itself Debug.Print Selection.Parent.Parent.FullName 'Path of the Excel App Debug.Print Selection.Parent.Parent.Parent.Path End Sub 

然后以某种方式编辑代码，它的工作原理。