Список всех подпапок, содержащих ключевое слово

Я нашел макрос Excel VBA, в котором перечислены все подпапки папки, но мне нужно перечислить только те подпапки, в имени которых есть определенное ключевое слово. Я действительно не знаю, с чего начать. Это то, что у меня есть до сих пор:

Sub ShowFolderList2()
    Dim fs, f, f1, fc, s, Keyword As String
    Dim folderspec
    Keyword = "test"
    folderspec = CurDir()
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFolder(folderspec)
    Set fc = f.SubFolders
    For Each f1 In fc
        s = s & f1.name
        s = s & vbCrLf
    Next
    Debug.Print folderspec
    Debug.Print s
End Sub

Мне удалось использовать Dir для вывода списка файлов определенного расширения, где его имя содержит ключевое слово, используя следующий скрипт:

'EXTENSION TEST
If Extension = "Excel" Then
File1 = Dir(MainPath & Path1 & "*.xl??")
Debug.Print (File1)

ElseIf Extension = "PDF" Then
File1 = Dir(MainPath & Path1 & "*.PDF")
Debug.Print (File1)

ElseIf Extension = "DIR" Then
File1 = Dir(MainPath & Path1 & KeyWord1 & "*", vbDirectory)

'Find path to File1 based on KeyWord1

While (File1 <> "")
   If InStr(File1, KeyWord1) > 0 Then
       'Print File1 path into A column starting in cell 3
       Sheet3.Cells(j + i, 1).Value = Path1 & File1
       i = i + 1
   End If
File1 = Dir
Wend

но я не могу составить список подпапок/каталогов. Любая помощь будет оценена.


excel vba dir
person Diego    schedule 01.08.2015    source источник
comment
Сколько уровней подпапок? Подпапки в папке соответствуют ключевому слову?   -  person    schedule 01.08.2015
comment
Если вы предпочитаете использовать подход Dir, вы должны превратить его в Sub с path и j в качестве аргументов. Затем, когда Extension = "DIR", снова вызовите Sub с путем и J (это называется рекурсивным).   -  person PatricK    schedule 04.08.2015

Ответы (2)


arrow_upward
3
arrow_downward

Объект Folder из библиотеки FileSystemObject содержит коллекцию SubFolders, которую можно использовать для итерации вложенных папок данной папки. Просто проверьте свойство Folder.Name, чтобы определить его имя и существует ли ваше ключевое слово.

Const strPath    As String = "c:\"
Const strKeyword As String = "program"
Dim objSubFolder As Object

With CreateObject("Scripting.FileSystemObject")
    For Each objSubFolder In .GetFolder(strPath).SubFolders
        If InStr(1, objSubFolder.Name, strKeyword, vbTextCompare) > 0 Then
            Debug.Print objSubFolder.Path
        End If
    Next
End With

На моей (64-битной) машине это печатает:

C:\Program Files
C:\Program Files (x86)
C:\ProgramData
person Bond    schedule 01.08.2015
comment
Идеально, это то, что я искал. Небольшие изменения, чтобы соответствовать моему сценарию, и до сих пор работает отлично. Большое спасибо - person Diego; 02.08.2015

arrow_upward
0
arrow_downward

Попробуйте следующее, изменяя константные выражения по мере необходимости - на короткое время появится черное окно CMD, это нормально:

Sub SO()

Const parentDrive As String = "C:\" '// Change as required
Const keyword As String = "myWord" '// Change as required
Dim results As Variant, folder As Variant

results = Split(CreateObject("WScript.Shell").Exec("CMD /C DIR """ & parentDrive & _
    "*" & keyword & "*"" /B /S /A:D").StdOut.ReadAll, vbCrLf)

For Each folder In results
    Debug.Print folder
Next

End Sub

Это запускает команду Dir через cmd.exe и считывает вывод обратно, затем разбивает вывод на разрывы строк, так что мы получаем массив каждой возвращенной папки.

В приведенном выше примере команда DIR C:\*myWord* /B /S /A:D запускается через CMD.

  • CMD /C – Оболочка CMD.exe (все, что следует за ним, передается в качестве аргумента – переключатель /C сообщает методу Shell закрыться после выполнения команды).
  • DIR C:\*myWord* – поиск *myWord* во всех каталогах в C:\ (обратите внимание на подстановочные знаки *).
  • /B Основнойосновной переключатель — отображает основной формат результатов.
  • /S Sпереключатель подпапок — просматривать все подпапки во время поиска.
  • /A:D Переключатель атрибута, принимающий параметр Ddirectory – возвращаются только результаты, имеющие атрибут каталога (не файла).
person SierraOscar    schedule 01.08.2015