Мне нужен более быстрый метод для рекурсивного поиска метаданных файла Метки, мой VBA-скрипт работает слишком медленно

Question

Я создал скрипт в VBA, который рекурсивно просматривает папки, чтобы найти метаданные «Теги» в файлах. Создание небольшой файловой структуры занимает более 20 минут, и мне нужно это для работы с гораздо большей файловой структурой. Является ли VBA неподходящим инструментом для работы?

В моем списке тегов для поиска и в каталоге файлов

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

Вот подпрограмма:

        Sub FolderSearcher(ByVal SourceFolder As String, KeywordList As Variant)
        'A recursive sub that searches metadata Tags for the Keywords and populates the output

        Dim oFSO, oSourceFolder, oSubFolder As Variant 'FSO
        Dim oShell, oDir As Variant 'Shell
        Dim KeywordListSize As Integer
        Dim DirectoryItem As Variant
        Dim vFileName, vFileKeyword As Variant
        Dim k As Integer 'Counter

        'Create FileSystemObject And Shell Application objects
        Set oFSO = CreateObject("Scripting.FileSystemObject")
        Set oSourceFolder = oFSO.GetFolder(SourceFolder)
        Set oShell = CreateObject("Shell.Application")

        KeywordListSize = UBound(KeywordList) - LBound(KeywordList)

        'Loop through all Sub folders
        For Each oSubFolder In oSourceFolder.SubFolders
            ' Look through all the files in the folder
            Set oDir = oShell.Namespace(oSubFolder.Path)
            For Each DirectoryItem In oDir.Items
                vFileName = oDir.GetDetailsOf(DirectoryItem, 0) 'Detail 0 is the file name
                If Right(vFileName, 4) = ".pdf" Then 'check if it's a PDF
                    vFileKeyword = PDFkeyword(oSubFolder.Path, vFileName) 'PDFs work a little differently
                Else
                    vFileKeyword = oDir.GetDetailsOf(DirectoryItem, 18) 'Detail 18 is the file tag
                End If

                If vFileKeyword = "" Then
                    GoTo NextDirItem
                End If

                ' Loop through all the searchlist keywords to check for a match
                For k = 0 To KeywordListSize
                    If vFileKeyword = KeywordList(k) Then
                        Call OutputSubroutine(oSubFolder.Path, vFileName, k)
                        Exit For
                    End If
                Next k

                NextDirItem:
            Next DirectoryItem

            'Recursive search through all the subfolders
            Call FolderSearcher(oSubFolder.Path, KeywordList)
        Next oSubFolder


        'Release Objects
        Set oSubFolder = Nothing
        Set oSourceFolder = Nothing
        Set oFSO = Nothing
        Set oDir = Nothing
        Set oShell = Nothing

    End Sub

Входные данные:
KeywordList - это одномерный массив переменной длины, содержащий строки.
SourceFolder - это строка, содержащая мой путь к файлу, т.е. \ files \ example

Я посмотрел на Оптимизировать скорость рекурсивного поиска файлов , но не было никаких полезных ответов.

Буду признателен за подсказки, как можно ускорить процесс. Или совет по другим языкам, которые могли бы выполнять эту работу более эффективно, чем VBA. Спасибо!

edit * Меня попросили добавить функцию ключевого слова PDF

Public Function PDFkeyword(InFilePath As Variant, InFileName As Variant) As String
    'This function is used to read the metadata from a PDF
    'Inputs: the folder path and file name
    'Output: the PDF keyword

    Dim oFile As String
    Dim oApp As Object
    Dim oDoc As Object
    Dim strFileName As String
    Dim strKeywords As String

    Set oApp = CreateObject("AcroExch.App")
    Set oDoc = CreateObject("AcroExch.PDDoc")
    oFile = InFilePath & "\" & InFileName

    'Grab the keywords from the PDF file
    With oDoc
      If .Open(oFile) Then
        'strFileName = .GetFileName    'not needed rn but could be handy
        strKeywords = .GetInfo("Keywords")
        .Close
      End If
    End With

    PDFkeyword = strKeywords

    'Release Objects
    Set oDoc = Nothing
    Set oApp = Nothing

End Function

Структура небольшого файла имела всего 3 уровня папок и 16 файлов. Большая структура, вероятно, имеет 5+ уровней папок и ~ 1000 файлов.

Answer 1

Это небольшая перезапись, чтобы удалить рекурсию и изменить вашу функцию PDF для использования переменных Stati c для объектов Acrobat.

На моем компьютере было обработано 3182 файлов примерно за 4,5 се c.

Sub FolderSearcher(ByVal SourceFolder As String, KeywordList As Variant)

    Dim oFSO, oSourceFolder, oSubFolder As Variant
    Dim oShell, oDir As Variant 'Shell
    Dim KeywordListSize As Long
    Dim DirectoryItem As Variant
    Dim vFileName, vFileKeyword As Variant
    Dim k As Long 'Counter
    Dim colFolders As New Collection
    Dim fldr, subFldr, fCount As Long

    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set oSourceFolder = oFSO.GetFolder(SourceFolder)
    Set oShell = CreateObject("Shell.Application")

    KeywordListSize = UBound(KeywordList) - LBound(KeywordList)

    colFolders.Add oSourceFolder  '<<< first folder for processing

    Do While colFolders.Count > 0

        Set fldr = colFolders(1)  'get the first folder to process
        colFolders.Remove 1       '...then remove from the collection

        For Each subFldr In fldr.subfolders 'capture subfolders for processing
            colFolders.Add subFldr
        Next subFldr

        Set oDir = oShell.Namespace(fldr.Path)
        For Each DirectoryItem In oDir.Items
            fCount = fCount + 1
            vFileName = oDir.GetDetailsOf(DirectoryItem, 0)
            If LCase(Right(vFileName, 4)) = ".pdf" Then
                vFileKeyword = PDFkeyword(fldr.Path, vFileName) 'PDFs work a little differently
            Else
                vFileKeyword = oDir.GetDetailsOf(DirectoryItem, 18) 'Detail 18 is the file tag
            End If

            If Len(vFileKeyword) > 0 Then
                Debug.Print "Got keyword:" & vFileKeyword
                For k = 0 To KeywordListSize
                    If vFileKeyword = KeywordList(k) Then
                        'Call OutputSubroutine(oSubFolder.Path, vFileName, k)
                        Debug.Print fldr.Path, vFileName, k
                        Exit For
                    End If
                Next k
            End If
        Next DirectoryItem
    Loop
    Debug.Print "Processed " & fCount & " files"
End Sub

Public Function PDFkeyword(InFilePath As Variant, InFileName As Variant) As String
    Dim oFile As String
    Static oApp As Object
    Static oDoc As Object
    Dim strFileName As String, strKeywords As String
    'only create objects once...
    If oApp Is Nothing Then Set oApp = CreateObject("AcroExch.App")
    If oDoc Is Nothing Then Set oDoc = CreateObject("AcroExch.PDDoc")

    oFile = InFilePath & "\" & InFileName
    With oDoc
      If .Open(oFile) Then
        strKeywords = .GetInfo("Keywords")
        .Close
      End If
    End With
    PDFkeyword = strKeywords
End Function