Макрос как в excel поиск файл

Функция FilenamesCollection предназначена для получения списка файлов из папки, с учётом выбранной глубины поиска в подпапках.

Используется рекурсивный перебор папок, до заданного уровня вложенности.
В процессе перебора папок, пути у найденным файлам помещаются в коллекцию (объект типа Collection) для последующего перебора.

К статье прикреплено 2 примера файла с макросами на основе этой функции:

• Пример в файле FilenamesCollection.xls выводит список файлов на чистый лист новой книги (формируя заголовки) 
• Пример в файле FilenamesCollectionEx.xls более функционален — он, помимо списка файлов из папки, отображает размер файла, и дату его создания, а также формирует в ячейках гиперссылки на найденные файлы.
  Вывод списка производится на лист запуска, параметры поиска файлов задаются в ячейках листа (см. скриншот)

ПРИМЕЧАНИЕ: Если вы выводите на лист список имен файлов картинок (изображений), то при помощи этой надстройки вы сможете вставить сами картинки в ячейки соседнего столбца (или в примечания к этим ячейкам)

Внимание: если требуется, чтобы поиск не зависел от регистра символов в маске файла
(к примеру, обнаруживались не только файлы .txt, но и .TXT и .Txt),
поставьте первой строкой в модуле директиву Option Compare Text

Function FilenamesCollection(ByVal FolderPath As String, Optional ByVal Mask As String = "", _
                             Optional ByVal SearchDeep As Long = 999) As Collection
    ' © EducatedFool  excelvba.ru/code/FilenamesCollection
    ' Получает в качестве параметра путь к папке FolderPath,
    ' маску имени искомых файлов Mask (будут отобраны только файлы с такой маской/расширением)
    ' и глубину поиска SearchDeep в подпапках (если SearchDeep=1, то подпапки не просматриваются).
    ' Возвращает коллекцию, содержащую полные пути найденных файлов
    ' (применяется рекурсивный вызов процедуры GetAllFileNamesUsingFSO)

    Set FilenamesCollection = New Collection    ' создаём пустую коллекцию
    Set FSO = CreateObject("Scripting.FileSystemObject")    ' создаём экземпляр FileSystemObject
    GetAllFileNamesUsingFSO FolderPath, Mask, FSO, FilenamesCollection, SearchDeep ' поиск
    Set FSO = Nothing: Application.StatusBar = False    ' очистка строки состояния Excel
End Function
 
Function GetAllFileNamesUsingFSO(ByVal FolderPath As String, ByVal Mask As String, ByRef FSO, _
                                 ByRef FileNamesColl As Collection, ByVal SearchDeep As Long)
    ' перебирает все файлы и подпапки в папке FolderPath, используя объект FSO
    ' перебор папок осуществляется в том случае, если SearchDeep > 1
    ' добавляет пути найденных файлов в коллекцию FileNamesColl
    On Error Resume Next: Set curfold = FSO.GetFolder(FolderPath)
    If Not curfold Is Nothing Then    ' если удалось получить доступ к папке

        ' раскомментируйте эту строку для вывода пути к просматриваемой
        ' в текущий момент папке в строку состояния Excel
        ' Application.StatusBar = "Поиск в папке: " & FolderPath

        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
            Next
        End If
        Set fil = Nothing: Set curfold = Nothing    ' очищаем переменные
    End If
End Function

‘ Пример использования функции в макросе:

Sub ОбработкаФайловИзПапки()
    On Error Resume Next
    Dim folder$, coll As Collection
 
    folder$ = ThisWorkbook.Path & "Платежи"
    If Dir(folder$, vbDirectory) = "" Then
        MsgBox "Не найдена папка «" & folder$ & "»", vbCritical, "Нет папки ПЛАТЕЖИ"
        Exit Sub        ' выход, если папка не найдена
    End If
 
    Set coll = FilenamesCollection(folder$, "*.xls")        ' получаем список файлов XLS из папки
    If coll.Count = 0 Then
        MsgBox "В папке «" & Split(folder$, "")(UBound(Split(folder$, "")) - 1) & "» нет ни одного подходящего файла!", _
               vbCritical, "Файлы для обработки не найдены"
        Exit Sub        ' выход, если нет файлов
    End If
 
    ' перебираем все найденные файлы
    For Each file In coll
        Debug.Print file        ' выводим имя файла в окно Immediate
    Next
End Sub

Этот код позволяет осуществить поиск нужных файлов в выбранной папке (включая подпапки), и выводит полученный список файлов на лист книги Excel:

Sub ПримерИспользованияФункции_FilenamesCollection()
    ' Ищем на рабочем столе все файлы TXT, и выводим на лист список их имён.
    ' Просматриваются папки с глубиной вложения не более трёх.

    Dim coll As Collection, ПутьКПапке As String
    ' получаем путь к папке РАБОЧИЙ СТОЛ
    ПутьКПапке = CreateObject("WScript.Shell").SpecialFolders("Desktop")
    ' считываем в колекцию coll нужные имена файлов
    Set coll = FilenamesCollection(ПутьКПапке, ".txt", 3)
 
    Application.ScreenUpdating = False    ' отключаем обновление экрана
    ' создаём новую книгу
    Dim sh As Worksheet: Set sh = Workbooks.Add.Worksheets(1)
    ' формируем заголовки таблицы
    With sh.Range("a1").Resize(, 3)
        .Value = Array("№", "Имя файла", "Полный путь")
        .Font.Bold = True: .Interior.ColorIndex = 17
    End With
 
    ' выводим результаты на лист
    For i = 1 To coll.Count ' перебираем все элементы коллекции, содержащей пути к файлам
        sh.Range("a" & sh.Rows.Count).End(xlUp).Offset(1).Resize(, 3).Value = _
        Array(i, Dir(coll(i)), coll(i))    ' выводим на лист очередную строку
        DoEvents    ' временно передаём управление ОС
    Next
    sh.Range("a:c").EntireColumn.AutoFit    ' автоподбор ширины столбцов
    [a2].Activate: ActiveWindow.FreezePanes = True ' закрепляем первую строку листа
End Sub

Ещё один пример использования:

Sub ЗагрузкаСпискаФайлов()
    ' Ищем файлы в заданной папке по заданной маске,
    ' и выводим на лист список их параметров.
    ' Просматриваются папки с заданной глубиной вложения.

    Dim coll As Collection, ПутьКПапке$, МаскаПоиска$, ГлубинаПоиска%
 
    ПутьКПапке$ = [c1]    ' берём из ячейки c1
    МаскаПоиска$ = [c2]    ' берём из ячейки c2
    ГлубинаПоиска% = Val([c3])    ' берём из ячейки c3
    If ГлубинаПоиска% = 0 Then ГлубинаПоиска% = 999    ' без ограничения по глубине

    ' считываем в колекцию coll нужные имена файлов
    Set coll = FilenamesCollection(ПутьКПапке$, МаскаПоиска$, ГлубинаПоиска%)
 
    Application.ScreenUpdating = False    ' отключаем обновление экрана

    ' выводим результаты (список файлов, и их характеристик) на лист
    For i = 1 To coll.Count    ' перебираем все элементы коллекции, содержащей пути к файлам

        НомерФайла = i
        ПутьКФайлу = coll(i)
        ИмяФайла = Dir(ПутьКФайлу)
        ДатаСоздания = FileDateTime(ПутьКФайлу)
        РазмерФайла = FileLen(ПутьКФайлу)
 
        ' выводим на лист очередную строку
        Range("a" & Rows.Count).End(xlUp).Offset(1).Resize(, 5).Value = _
        Array(НомерФайла, ИмяФайла, ПутьКФайлу, ДатаСоздания, РазмерФайла)
 
        ' если нужна гиперссылка на файл во втором столбце
        ActiveSheet.Hyperlinks.Add Range("b" & Rows.Count).End(xlUp), ПутьКФайлу, "", _
                                   "Открыть файл" & vbNewLine & ИмяФайла
 
        DoEvents    ' временно передаём управление ОС
    Next
End Sub

PS: Найти подходящие имена файлов в коллекции можно при помощи следующей функции:

Function CollectionAutofilter(ByRef coll As Collection, ByVal filter$) As Collection
    ' Функция перебирает все элементы коллекции coll,
    ' оставляя лишь те, которые соответствуют маске filter$ (например, filter$="*некий текст*")
    ' Возвращает коллекцию, содержащую только подходящие элементы
    ' Если элементы не найдены - возвращается пустая коллекция (содержащая 0 элементов)
    On Error Resume Next: Set CollectionAutofilter = New Collection
    For Each Item In coll
        If Item Like filter$ Then CollectionAutofilter.Add Item
    Next
End Function

• 301874 просмотра

1. 

   1

   Learn the following key concepts of the FIND command:

   • The syntax of .Find is:
     • expression.Find(What, After, LookIn, LookAt, SearchOrder, SearchDirection, MatchCase, MatchByte, SearchFormat)
     • Expression (Required): is any valid range Object. So if we take an example then the range would be Range(“A1:A” & lastRow) where lastRow has been DIMensioned as type long and there is a statement: lastRow = oSht.Range(«A» & Rows.Count).End(xlUp).Row (or something similar) preceding its use in the .Find required expression.
     • What (Optional Variant): is the “Search value”
     • After (Optional Variant): The cell after which you want the search to begin.
     • LookIn (Optional Variant): The type of information. (xlValues or xlFormulas)
     • LookAt (Optional Variant): Can be one of the following XlLookAt constants: xlWhole or xlPart.
     • SearchOrder (Optional Variant): Can be one of the following #** XlSearchOrder constants: xlByRows or xlByColumns.
     • SearchDirection: Can be one of these XlSearchDirection constants. xlNext default xlPrevious
     • MatchCase (Optional Variant): True to make the search case sensitive. The default value is False.
     • MatchByte (Optional Variant): Used only if you’ve selected or installed double-byte language support. True to have double-byte characters match only double-byte characters. False to have double-byte characters match their single-byte equivalents.
     • SearchFormat (Optional Variant): The search format.

2. 

   2

   You can adapt the following code to your own uses by copying it (down to where it says #** End Sub) in Advanced Editing and pasting it to a word processor and doing a REPLACE ALL for «#** » (w/o the quotes but with the trailing space please). Then in Excel Preferences, set the Ribbon Developer status to Checked or On so you can work with macros. On the Ribbon, click on Developer, and then the Record icon and just click in cell A1 and then do Stop Recording (of your dummy macro). Click on the Editor icon button and copy your REPLACE(d) ALL text from your word processor from here right over the macro, and save the workbook.

   Advertisement

3. 

   3

   Open a new Excel workbook. Save the workbook as «Overall Status» and Sheet1 as «Article Views and Other».

4. 

   4

   In your browser, go to https://www.wikihow.com/User:Chris-Garthwaite and do (View More) under Articles Started, and select just to the left of the first top one down to just to the right of the bottom one’s Views, and copy it. Make sure you don’t get any excess info, just the articles and number of views. Then paste that data into the «Article Views and Other» worksheet at cell C17. Then, in your browser, go to https://www.wikihow.com/User:Xhohx and copy all 100 expanded (View More) Articles and Views from there too please, and paste those in the cell right below the ones you did before.

5. 

   5

   Then. on your toolbar, choose Macros, Macros, and Run the following pasted-in REPLACE(d) ALL macro to test it.

   • • Sub Macro2_FindArticle()
     • ‘ Finds an Article String, returns cell address and goes to Article cell
     • ‘ Macro2_FindArticle Macro
     • Dim oSht As Worksheet
     • Dim StrFinder As String
     • Dim lastRow As Range
     • Dim aCell As Range
     • Set oSht = Sheets(«Article Views and Other»)
     • Set lastRow = ActiveWorkbook.Sheets(«Article Views and Other»).Range(«C17:C217»)
     • Application.ScreenUpdating = True
     • Do Until StrFinder <> «»
     • StrFinder = Application.InputBox _
     • (Prompt:=»Article Name or string to search for: «, _
     • Title:=»Article Search», _
     • Type:=2)
     • Set aCell = lastRow.Find(What:=StrFinder, LookIn:=xlValues, _
     • LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
     • MatchCase:=False)
     • If Not aCell Is Nothing Then
     • MsgBox «Value Found in Cell » & aCell.Address
     • End If
     • aCell.Select
     • Application.ScreenUpdating = False
     • Exit Sub
     • Loop
     • End Sub
     • You should have a list of articles something like this redacted image, probably without the colored background.

6. 

   6

   Note that if you were to use Excel’s menu-driven Find command, it would return in the upper left corner (to the left of the formula bar) the cell reference it found, if any, for the string you searched on in the given range of cells, but you would have to hit the right arrow and left arrow (or some such combination) to select the actual cell as the sole ActiveCell I believe. At least, that’s how Excel functions in this author’s experience — not obviously high lighting the cell for me or obviously selecting it, as it used to do in older versions of Excel.

7. 

   7

   Note that the underline used at the right end of code lines is to extend the line to the next line down, so the next line is in fact part of the entire sub-procedure or expression.

8. 

   8

   You can easily adapt this code by changing the sheet name reference and the cell range reference, and if it’s not an Article you’re searching for, you can certainly change that everywhere as well.

9. 

   9

   Here are two more macros that work together to update Related wikiHows:

   • • Sub Macro10()
     • ‘ Macro10 Macro
     • ‘ Keyboard Shortcut: Option+Cmd+n
     • Windows(«OVERALL STATUS.xlsm»).Activate
     • Sheets(«Relateds»).Select
     • Application.Goto Reference:=»TopRow»
     • Application.CutCopyMode = False
     • Selection.Delete Shift:=xlUp
     • ActiveWorkbook.Names.Add Name:=»TopRow», RefersToR1C1:=»=Relateds!R166″
     • Range(«B166»).Select
     • Selection.Copy
     • Application.Goto Reference:=»Searcher»
     • ‘ Searcher is a Defined Name Variable comprised of the Article Names
     • ‘ and Views pasted AS TRANSPOSED from rows TO COLUMNS in row 1.
     • Macro3_FindRelated
     • End Sub
     • Sub Macro3_FindRelated()
     • ‘ Finds a Related wikiHow String and goes to Article cell,
     • ‘ where User then Arrow keys down and inputs a 1,
     • ‘ indicating that that Columnar Article is a Related for the Row Article.
     • ‘ There are both row totals and columnar totals to keep track of Total Relateds/Article
     • ‘ and how many Articles the Columnar Article is a Related for.
     • ‘ Uses the Named Variable Range, «Searcher», on the worksheet «Relateds» as a Range Object
     • ‘ Macro3_FindRelated Macro
     • Dim oSht As Worksheet
     • Dim StrFinder As String
     • Dim aCell As Range
     • Dim rng As Range
     • Set oSht = Sheets(«Relateds»)
     • Windows(«OVERALL STATUS.xlsm»).Activate
     • Sheets(«Relateds»).Select
     • Set rng = Worksheets(«Relateds»).Range(«Searcher»)
     • Application.ScreenUpdating = True
     • Do Until StrFinder <> «»
     • StrFinder = Application.InputBox _
     • (Prompt:=»Article Name or string to search for: «, _
     • Title:=»Article Search», _
     • Type:=2)
     • Set aCell = rng.Find(What:=StrFinder, LookIn:=xlValues, _
     • LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
     • MatchCase:=False)
     • aCell.Select
     • Application.ScreenUpdating = False
     • Exit Sub
     • Loop
     • End Sub
     • In cell H1 is xxxxxxxxxxxxxxxxxx and I1 is blank. From J1 to ET1 are the Article Titles and in EU1 is Other — a reconciling account rarely used. From J4 to EW4 are the Article views and their Total. From J6 to ET6 are the Article#s from 141 down to 1 (most recent at far left, oldest at far right). All of that was pasted as Transposed from cell range B10:G153.
     • In cell A166 is [xxxxxxxxxxxxxxxxxxx| and that is copied far down below, as it gets deleted with continued usage.
     • In cell B166 is the formula =IF(ISERR(MID(A166,D166+2,(E166-D166)-2)),»»,MID(A166,D166+2,(E166-D166)-2)) which returns the value, xxxxxxxxxxxxxxxxxx.
     • In cell D166 is the formula =IF(ISERR(FIND(«[«,A166)),»»,FIND(«[«,A166)), which returns the value of 1.
     • In cell E166 is the formula =IF(ISERR(FIND(«|»,A166)),»»,FIND(«|»,A166)), which returns 21.
     • In cell A9 is the formula =»*[[«&B9&»|How to «&B9&»]]»
     • When the formula in A9 is copied to A10, and the Article Name Find the Diagonal of a Square Using Its Area is in B10, A10 returns the value, *[[Find the Diagonal of a Square Using Its Area|How to Find the Diagonal of a Square Using Its Area]]
     • Whether copied from the first sheet in the workbook, Article Views and Other, or from this sheet, Relateds, these ready-to-become-Related formatted entries in column A are then pasted, if they’re appropriate How-To’s for the article being updated, to cell B167 and below before the following macro is run and command v pasting is done into the InputBox to locate the Article in the top Searcher area to arrow key down and update the proper row (Article) with a 1 to.

Advertisement

Advertisement

Advertisement

About This Article

Thanks to all authors for creating a page that has been read 51,690 times.