VBA - 在特定值的目錄中搜索所有excel工作簿。如果找到值，請列出工作簿文件路徑？

Question

我正在使用以下代碼來搜索目錄中的所有excel工作簿，並列出找到匹配值的所有匹配值及其單元格引用和每個工作簿。

這幾乎工程。但不是工作簿名稱，它給了我工作表名稱。

我想列出工作簿名稱，並且還想列出工作簿文件路徑。在幾列中。

我試圖通過添加以下行來做到這一點：

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

但是這會產生一個類型不匹配錯誤。

我也試過：

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

一般情況下，選擇一個單元格寫：

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 

隨後的方式編輯代碼，它的工作原理。