excel - VBA search closed workbook(s) for value?

Question

I am trying to search all excel workbooks in a folder (and sub folders) for a value.

My folder structure where my excel workbooks are is like so:

destPath = "G:WH DISPO(3) PROMOTIONS(18) Food Specials Delivery TrackingArchive"

Then within my archive folder there are various sub folders like

+ 2017
- April
- May

+ 2016
- April
- May

The names of the workbooks might all be different, so the code will need to probably use something like wildcards *.xlsm

Here's what i have so far:

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 TrackingArchive"
    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

The ranges in each workbook should always stay the same.

I am trying something simple, like display a message when the value is found. But at the moment, despite the value existing in the workbook i am getting no result/no message.

I get an object required error on this line:

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

Please can someone show me where i am going wrong?

EDIT:

Can i change the message box to a for each loop to list each result like so:

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

Desired Result

Answer 1

The way your code is set up won't work. You cannot use the Workbooks.Open() method with a wildcard, as it will only open one file at a time and doesn't search for a file. There are two ways of searching through a directory for a file with a particular naming pattern that I know of. The easiest way is using the Dir() function, but this won't recurse into subfolders very easily.

The second way (coded out for you below) is a way of recursing through files and subfolders that uses the FileSystemObject. In order to use this, you will need to add a reference to your project to the Microsoft Scripting Runtime library. You add the reference via Tools->References.

Also note that this method uses the Range.Find() method to find the client name in your workbooks as it should be quicker and easier to understand than your current method of finding whether the client name is in the worksheet.

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 TrackingArchive"

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