VBA code to search for a string in all workbooks in a directory not working

frankbrett

New Member
Joined
Feb 11, 2014
Messages
6
Hi,

I have been modifying some code I found elsewhere that searches all workbooks in a directory for a defined text string and then lists the locations of that text in a new worksheet (ie workbook name and cell reference). I can get it to partially work for my own data but there is an error somewhere in the directory definition that is stopping it doing a full loop of all the workbooks in the directory and populating the new sheet with the locations of my defined text string. Code is below. The lines highlighted in bold are where I suspect the errors may be.

The constant 'myfolder' I have defined as the the location of the files I want to search and '\' to signify all files in the directory.

The line 'Value = Dir(myfolder) is taken from code I am modifying but I don't know if I need it.

Finally, the line 'Value=Dir' at the end of my code gives me a 'loop without do error'
Any help would be greatly appreciated.

Code:
[FONT=arial]Sub SearchWKBooks()[/FONT]
[FONT=arial]
[/FONT]
[FONT=arial]Dim WS As Worksheet[/FONT]
[FONT=arial]Dim myfolder As String[/FONT]
[FONT=arial]Dim Str As String[/FONT]
[FONT=arial]Dim a As Single[/FONT]
[FONT=arial]Dim sht As Worksheet[/FONT]
[FONT=arial]Set WS = Sheets.Add[/FONT]
[FONT=arial]With Application.FileDialog(msoFileDialogFolderPicker)[/FONT]
[FONT=arial]   .Show[/FONT]
[FONT=arial][B]   myfolder = "Z:\XXX\XXX" & "\"[/B][/FONT]
[FONT=arial]End With[/FONT]
[FONT=arial]Str = Application.InputBox(prompt:="Search string:", Title:="Search all workbooks in a folder", Type:=2)[/FONT]
[FONT=arial]If Str = "" Then Exit Sub[/FONT]
[FONT=arial]WS.Range("A1") = "Search string variable"[/FONT]
[FONT=arial]WS.Range("B1") = Str[/FONT]
[FONT=arial]WS.Range("A2") = "Path:"[/FONT]
[FONT=arial]WS.Range("B2") = myfolder[/FONT]
[FONT=arial]WS.Range("A3") = "Workbook"[/FONT]
[FONT=arial]WS.Range("B3") = "Worksheet"[/FONT]
[FONT=arial]WS.Range("C3") = "Cell Address"[/FONT]
[FONT=arial]WS.Range("D3") = "Link"[/FONT]
[FONT=arial]a = 0[/FONT]
[FONT=arial][B]Value = Dir(myfolder)[/B][/FONT]
[FONT=arial]Do Until Value = ""[/FONT]
[FONT=arial]
[/FONT]
[FONT=arial]If Value = "." Or Value = ".." Then[/FONT]
[FONT=arial]
[/FONT]
[FONT=arial]Else[/FONT]
[FONT=arial]If Right(Value, 3) = "csv" Or Right(Value, 4) = "xlsx" Or Right(Value, 4) = "xlsm" Then[/FONT]
[FONT=arial]On Error Resume Next[/FONT]
[FONT=arial]           Workbooks.Open Filename:=myfolder & Value            [/FONT]
[FONT=arial]If Err.Number > 0 Then[/FONT]
[FONT=arial]               WS.Range("A4").Offset(a, 0).Value = Value[/FONT]
[FONT=arial]               WS.Range("B4").Offset(a, 0).Value = "Password protected"[/FONT]
[FONT=arial]               a = a + 1[/FONT]
[FONT=arial]
[/FONT]
[FONT=arial]Else[/FONT]
[FONT=arial]On Error GoTo 0[/FONT]
[FONT=arial]For Each sht In ActiveWorkbook.Worksheets[/FONT]
[FONT=arial]Set c = sht.Cells.Find(Str, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext)[/FONT]
[FONT=arial]If Not c Is Nothing Then[/FONT]
[FONT=arial]                           firstAddress = c.Address[/FONT]
[FONT=arial]Do[/FONT]
[FONT=arial]                               WS.Range("A4").Offset(a, 0).Value = Value[/FONT]
[FONT=arial]                               WS.Range("B4").Offset(a, 0).Value = sht.Name[/FONT]
[FONT=arial]                               WS.Range("C4").Offset(a, 0).Value = c.Address[/FONT]
[FONT=arial]                               WS.Hyperlinks.Add Anchor:=WS.Range("D4").Offset(a, 0), Address:=myfolder & Value, SubAddress:= _[/FONT]
[FONT=arial]                               sht.Name & "!" & c.Address, TextToDisplay:="Link"[/FONT]
[FONT=arial]                               a = a + 1[/FONT]
[FONT=arial]Set c = sht.Cells.FindNext(c)[/FONT]
[FONT=arial]Loop While Not c Is Nothing And c.Address <> firstAddress[/FONT]
[FONT=arial]End If[/FONT]
[FONT=arial]Next sht[/FONT]
[FONT=arial]End If[/FONT]
[FONT=arial]Workbooks(Value).Close False[/FONT]
[FONT=arial]On Error GoTo 0[/FONT]
[FONT=arial]End If[/FONT]
[FONT=arial][B]End If[/B][/FONT]
[FONT=arial][B]   Value = Dir[/B][/FONT]
[FONT=arial]Loop[/FONT]
[FONT=arial]Cells.EntireColumn.AutoFit[/FONT]
[FONT=arial]End Sub[/FONT]
[FONT=arial]
[/FONT]
 

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.
You do need the Value = Dir(myfolder)

And your code worked for me as well. No Error thrown.
 
Upvote 0

Forum statistics

Threads
1,214,940
Messages
6,122,352
Members
449,080
Latest member
Armadillos

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top