There is a working search code for a variety of Excel files, with the full address displayed in the form of a list of hyperlinks. How to implement the search not only in the same level, but also in ALL the subfolders nested, with the option of either turning off the deep search or warning that it is turned on (I think you can hang the computer tightly if you choose too much space).

Sub ПОИСК() Dim folder_$, file_$, s$ Dim rw& Dim sh '---------------------------' rw = 4 With ThisWorkbook.Sheets(1) .UsedRange.Offset(3, 0).EntireRow.Delete s = .Cells(2, 3).Value End With If s = "" Then MsgBox "Не заполненно поле поиска!" Exit Sub End If With Application With .FileDialog(msoFileDialogFolderPicker) If .Show = False Then Exit Sub folder_ = .SelectedItems(1) End With folder_ = folder_ & IIf(Right(folder_, 1) = .PathSeparator, "", .PathSeparator) .ScreenUpdating = False End With file_ = Dir(folder_ & "*.xls*") Do While file_ <> "" DoEvents If file_ <> ThisWorkbook.Name Then Workbooks.Open folder_ & file_ With ActiveWorkbook For Each sh In .Sheets Set c = sh.Cells.Find(What:=s, After:=sh.Cells(1, 1), LookIn:=xlValues, LookAt:=xlPart) If Not c Is Nothing Then With ThisWorkbook.Sheets(1) .Cells(rw, 1) = folder_ & ActiveWorkbook.Name .Hyperlinks.Add Anchor:=.Cells(rw, 1), Address:=folder_ & ActiveWorkbook.Name, SubAddress:=c.Address End With rw = rw + 1 Exit For End If Next .Close False End With End If file_ = Dir Loop Application.ScreenUpdating = True Beep MsgBox "Готово!" End Sub Sub Макрос2() Set c = Cells.Find(What:="жжж", After:=ActiveCell, LookIn:=xlValues, LookAt:= _ xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _ , SearchFormat:=False) End Sub
  • Excel is spelled correctly. - nick_n_a
  • How to implement a search not only in one level, but also in ALL subfolders nested. 1) Separate I / O from the search - select the actual search in the procedure. 2) after completing the search cycle in the search procedure, get a list of subdirectories and recursively call yourself the same for each subdirectory. with the ability to ... disable deep search An additional parameter is in the cell of a sheet, form, or via the InputBox. - Akina

1 answer 1

Found in the glove compartment :)

Unfortunately, the author's name is not preserved.

Enabled by FSO ( FileSystemObject ). A collection of the names of all found subfolders is created.

FolderPath - the path to the source folder. The search depth is set by the variable SearchDeep . The created list of folders can be viewed in the Immediate Window .

 Function FilenamesCollection(ByVal FolderPath As String, Optional ByVal Mask As String = "", _ Optional ByVal SearchDeep As Long = 999) As Collection Dim FSO ' применяется рекурсивный вызов процедуры GetAllFileNamesUsingFSO' Set FilenamesCollection = New Collection ' создаём пустую коллекцию' Set FSO = CreateObject("Scripting.FileSystemObject") ' создаём экземпляр FileSystemObject' GetAllFileNamesUsingFSO FolderPath, Mask, FSO, FilenamesCollection, SearchDeep ' поиск' Set FSO = Nothing ' освобождаем память' End Function Function GetAllFileNamesUsingFSO(ByVal FolderPath As String, ByVal Mask As String, ByRef FSO, _ ByRef FileNamesColl As Collection, ByVal SearchDeep As Long) ' перебирает все файлы и подпапки в папке FolderPath, используя объект' ' перебор папок осуществляется в том случае, если SearchDeep > 1' ' добавляет пути найденных файлов в коллекцию FileNamesColl' On Error Resume Next: Set curfold = FSO.GetFolder(FolderPath) If Not curfold Is Nothing Then ' если удалось получить доступ к папке' For Each fil In curfold.Files ' перебираем все файлы в папке FolderPath' If fil.Name Like "*" & Mask Then FileNamesColl.Add fil.Path Next SearchDeep = SearchDeep - 1 ' уменьшаем глубину поиска в подпапках' If SearchDeep Then ' если надо искать глубже' For Each sfol In curfold.SubFolders ' перебираем все подпапки в папке FolderPath' GetAllFileNamesUsingFSO sfol.Path, Mask, FSO, FileNamesColl, SearchDeep Debug.Print sfol.Path, Mask, FSO, FileNamesColl, SearchDeep Next End If Set fil = Nothing: Set curfold = Nothing ' освобождаем память' End If End Function

Use Application.FileDialog to set the source folder and use the collection before the line

 file_ = Dir(folder_ & "*.xls*")