Excel Macro для поиска папок и возвратных файлов, содержащих определенное ключевое слово и самую последнюю версию

Question

Я ищу некоторую помощь в написании макроса, который будет искать папку на моем компьютере, чтобы узнать, содержит ли какой-либо из файлов в папке указанное ключевое слово , затем верните имя файла, путь и последнюю измененную дату на листе excel.

REF  FolderPath  REF FileName LastModified FilePath 
Apple C:\Fruits   
Kale C:\Vegetables   
Spinach C:\Vegetables 

Например (см выше),

Я есть ключевые слова и пути к папкам в столбце A и B. Папка под названием «Фрукты» содержит файл с именем «Apple_v5.xls». Поэтому я хотел бы, чтобы макрос искал ключевое слово «Apple», а затем вернул имя, самую последнюю версию и путь к файлу (Col D, E, F) в ту же таблицу. Col C просто перечислит их ключевые слова в Col A. Macro также будет продолжать переходить по списку ключевых слов, пока не достигнет конца.

Это то, что я до сих пор изучал в Интернете, но по какой-то причине это не сработало. Пожалуйста помоги! Благодаря!

Private Sub CommandButton1_Click() 

    Dim sh As Worksheet, rng As Range, lr As Long, fPath As String 
    Set sh = Sheets("Sheet2") 
    lstRw = sh.Cells.Find(What:="*", After:=sh.Range("A1"), LookAt:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious,     MatchCase:=False).Row 
    Set rng = sh.Range("A2:A" & lstRw) 

    For i = 1 To 100 

    fPath = Sheets("Sheet2").Range("B" & i).Value 

    If Right(fPath, 1) <> "\" Then 
    fPath = fPath & "\" 
    End If 

    fWb = Dir(fPath & "*.*") 
    x = 2 
    Do While fWb <> "" 
    For Each c In rng 
    If InStr(LCase(fWb), LCase(c.Value)) > 0 Then 
    Worksheets("Sheet2").Range("C" & x) = fWb 
    Set fs = CreateObject("Scripting.FileSystemObject") 
    Set f = fs.GetFile(fWb) 
    Worksheets("Sheet2").Range("E" & x) = f.DateLastModified 
    Worksheets("Sheet2").Range("F" & x) = f.Path 
    Worksheets("sheet2").Range("D" & x) = c.Value 
    Worksheets("sheet2").Hyperlinks.Add Anchor:=Worksheets("sheet2").Cells(x, 2), Address:=f.Path 
    Columns("A:D").AutoFit 
    Set fs = Nothing 
    Set f = Nothing 
    x = x + 1 
    End If 
    Next 
    fWb = Dir 
    Loop 
    Set sh = Nothing 
    Set rng = Nothing 

    Next i 

    Sheets("Sheet2").Activate 

    End Sub 

Answer 1

У вас есть несколько проблем с некоторыми из кода/схемы здесь. Без существенного повторного написания большей части макроса для вас, вот подход, который вы можете использовать.

--- Получить диапазон ячеек, которые имеют ключевое слово (вы это уже с вашей rng)

--- Установить счетчик строк (вы уже используете переменную x, чтобы сделать это)

--- Перебор каждой ячейки в диапазоне (вы это уже используя for each c in rng код)

Затем в течение этого цикла ...

--- Получить FilePath из колонки B (вы это делаете аль готовы, когда вы установите переменную fPath)

--- Выберите папку для первого файла с ключевым словом, используя следующий код

fwb = Dir(fPath & c.Value & ".*") 

Это занимает ваше значение REF и вставляет его в пути к папке. * в ". *" заявляет, что вы хотите, чтобы он возвращал любой тип файла (например, Apple.txt, Apple.pdf, Apple.mp3)

- Если файл был найден, то укажите дату последнего изменения, путь, имя файла, и гиперссылка (все из которых вы знаете, как это сделать уже, как указано в остальной части кода)

- Reset файл и FileSystemObject переменные (f и fs)

Наконец, вне вашей петли вы можете сбросить другие переменные (то есть sh, rng) Надеюсь, это поможет.