Excel VBA + Создать список полных имен файлов с именами базовых имен файлов (или аналогичными)

Question

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

Фрагмент на самом деле является номером детали детали, а файлы для поиска - все типа. .Ww. Кроме того, они называются серией, которая помогает сортировать их; т.е. 1XX-XXXX.idw, 2XX-XXX.idw.

Есть 50 000+ файлов и только с использованием файла FileScriptingObject и рекурсивного чтения каждой папки, тогда их сравнение занимает примерно 2 минуты на поиск.

(дан список номеров деталей, мне нужно заполнить столбец в Excel с полным именем файла)

Я предполагаю, что мой лучший способ пойти об этом будет генерировать индексированный список всех файлы idw, которые я ищу, уменьшая полную строку файла до только базового имени и используя это как ключ. Тем не менее, это все равно потребовало бы своевременного запуска в начале каждого поиска, предполагая, что я использую этот словарь/сбор/список снова и снова для каждого запуска.

Есть ли способ сохранить словарь во внешнем файле, чтобы я мог генерировать индексированный список один раз в день или намного реже?

В противном случае, есть ли лучший способ сделать это с помощью VBA, о котором я не думал?

Answer 1

После комментария от @omegastripes вы можете комбинировать три метода для достижения цели.

1. Используйте Exec метод WScript.Shell для запуска команды Dir - вероятно, быстрее, чем при использовании FileSystemObject
2. SplitStdOut получить Variant массив всех имен файлов возвращается - это один раз ударил, чтобы получить список файлов, которые вы хотите искать по
3. Используйте функцию Filter, чтобы уменьшить массив только на имена файлов, включая те, которые вам интересны при отображении в электронной таблице.

Команда DIR использует некоторые параметры, которые имеют важное значение для задачи:

• /S - рекурсивная через подкаталоги
• /B - голые имена только
• /A:-D - исключить каталоги из вывода, т.е. только файлы

код примера:

Option Explicit 

Sub Test() 

    Dim arrFiles As Variant 
    Dim arrSearchTerms As Variant 
    Dim arrMatches As Variant 
    Dim intTargetCounter As Integer 
    Dim intMatchCounter As Integer 

    'get files 
    arrFiles = GetFileList("C:\WINDOWS", "idw") 
    If UBound(arrFiles) = 0 Then 
     MsgBox "No files found" 
     Exit Sub 
    End If 

    'iterate search terms and check collection 
    arrSearchTerms = Array("1XX-XXXX", "2XX-XXXX") 
    For intTargetCounter = LBound(arrSearchTerms) To UBound(arrSearchTerms) 
     arrMatches = Filter(arrFiles, arrSearchTerms(intTargetCounter)) 
     For intMatchCounter = LBound(arrMatches) To UBound(arrMatches) 
      Debug.Print arrMatches(intMatchCounter) 
     Next intMatchCounter 
    Next intTargetCounter 

End Sub 

Function GetFileList(strRoot As String, strExtensionFilter As String) As Variant 

    Dim objShell As Object 
    Dim strCommand As String 
    Dim objShellExe As Object 

    On Error GoTo CleanUp 

    'call cmd 
    Set objShell = CreateObject("WScript.Shell") 
    strCommand = "%COMSPEC% /C DIR /S /B /A:-D *." & strExtensionFilter 
    objShell.CurrentDirectory = strRoot 
    Set objShellExe = objShell.Exec(strCommand) 

    'wait for listing 
    While objShellExe.Status <> 1 
     DoEvents 
    Wend 

    'convert std out to array 
    GetFileList = Split(objShellExe.StdOut.ReadAll, vbCrLf) 

CleanUp: 
    If Err.Number <> 0 Then 
     Debug.Print Err.Number & ": " & Err.Description 
    End If 
    Set objShellExe = Nothing 
    Set objShell = Nothing 

End Function