I all,
I'm using a macro that I found in network; this macro making a search of a string in selected folder and subfolders. I'd like that at the end of the search:
This is the macro:
I'm using a macro that I found in network; this macro making a search of a string in selected folder and subfolders. I'd like that at the end of the search:
- if not found something appear the message: "no found string"
- if find something appear the message: "found "X" result"
This is the macro:
Code:
Public WS As Worksheet
Sub SearchWKBooksSubFolders(Optional Folderpath As Variant, Optional Str As Variant)
ActiveSheet.Unprotect
Dim myfolder As String
Dim a As Single
Dim sht As Worksheet
Dim Lrow As Single
Dim Folders() As String
Dim Folder As Variant
ReDim Folders(0)
If IsMissing(Folderpath) Then
Set WS = ThisWorkbook.Sheets("CERCA_DISTINTA")
With Application.FileDialog(msoFileDialogFolderPicker)
.Show
If .SelectedItems.Count = 0 Then Exit Sub
myfolder = .SelectedItems(1) & "\"
End With
Str = Application.InputBox(prompt:="Inserisci stringa da cercare:", Title:="Cerca in tutte le cartelle", Type:=2)
If Str = "" Then Exit Sub
WS.Range("B1") = Str
WS.Range("B2") = myfolder
Folderpath = myfolder
Value = Dir(myfolder, &H1F)
Else
If Right(Folderpath, 2) = "\\" Then
Exit Sub
End If
Value = Dir(Folderpath, &H1F)
End If
Do Until Value = ""
If Value = "." Or Value = ".." Then
Else
If GetAttr(Folderpath & Value) = 16 Then
Folders(UBound(Folders)) = Value
ReDim Preserve Folders(UBound(Folders) + 1)
ElseIf Right(Value, 3) = "xls" Or Right(Value, 4) = "xlsx" Or Right(Value, 4) = "xlsm" Then
On Error Resume Next
Workbooks.Open Filename:=Folderpath & Value, password:="zzzzzzzzzzzz"
If Err.Number <> 0 Then
WS.Range("A4").Offset(a, 0).Value = Value
WS.Range("B4").Offset(a, 0).Value = "Password protected"
a = a + 1
Else
On Error GoTo 0
For Each sht In ActiveWorkbook.Worksheets
Set c = sht.Cells.Find(Str, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext)
If Not c Is Nothing Then
firstAddress = c.Address
Do
Lrow = WS.Range("A" & Rows.Count).End(xlUp).Row
WS.Range("A1").Offset(Lrow, 0).Value = Folderpath
WS.Range("B1").Offset(Lrow, 0).Value = Value
WS.Range("C1").Offset(Lrow, 0).Value = sht.Name
WS.Range("D1").Offset(Lrow, 0).Value = c.Address
WS.Hyperlinks.Add Anchor:=WS.Range("E1").Offset(Lrow, 0), Address:=Folderpath & Value, SubAddress:= _
sht.Name & "!" & c.Address, TextToDisplay:="Link"
Set c = sht.Cells.FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
Next sht
End If
Workbooks(Value).Close False
On Error GoTo 0
End If
End If
Value = Dir
Loop
For Each Folder In Folders
SearchWKBooksSubFolders (Folderpath & Folder & "\")
Next Folder
Cells.EntireColumn.AutoFit
ActiveSheet.Protect
End Sub