Excel VBA + 生成给定文件基名（或类似名称）的完整文件名列表

Question

我需要在文件系统（通常是驱动器）中搜索完全定义的文件路径，同时只给出文件名的一部分。

片段实际上是零件的零件编号，要搜索的文件都是'.idw'类型。此外，它们以有助于对其进行排序的系列命名；即1XX-XXXX.idw，2XX-XXX.idw。

有 50,000 多个文件，仅使用 FileScriptingObject 并递归读取每个文件夹然后比较它们每次搜索大约需要 2 分钟。

（给定零件编号列表，我需要在 Excel 中用完整文件名填充一列）

我猜我最好的解决方法是生成我正在寻找的所有 idw 文件的索引列表，将完整的文件字符串减少为仅基本名称并将其用作键。但是，这仍然需要在每次搜索开始时及时运行，假设我每次运行都一遍又一遍地使用这个字典/集合/列表。

有什么方法可以将字典存储在外部文件中，这样我就可以每天生成一次索引列表，或者少很多？

否则，有没有更好的方法来使用我没有想到的 VBA？

Answer 1

根据@omegastripes 的评论，您可以结合三种方法来实现目标。

1. 使用WScript.Shell 的Exec 方法运行Dir 命令 - 可能比使用FileSystemObject 更快
2. Split StdOut 得到一个包含所有返回文件名的 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