使用基于单元格值的excel VBA打开文件，路径由相同的值动态组成

Posted 2023-04-19

【中文标题】使用基于单元格值的excel VBA打开文件，路径由相同的值动态组成

【英文标题】：Using excel VBA open file based on cell value with path composed on the fly from same value

【发布时间】：2016-06-14 19:25:38

【问题描述】：

这是目标。用户从网络驱动器打开只读工作簿。选择具有文件名的单元格，然后单击宏按钮，该按钮将查找并打开与单元格值匹配的每个文件的数量。

实现该结果的最有效方法是什么？请记住：

用户不希望每次打开工作簿时都等待 excel 编译带有文件的目录结构。 文件名将始终与包含文件夹名称的某些部分匹配 文件 135A1200 将位于文件夹 135A12XX 中 具有不同级别子文件夹的数十个文件夹/子文件夹 数以千计的文件不断变化 文件夹层次结构是半永久性的 一致的文件/文件夹命名格式： 总是以三个数字开头 后跟一到三个字母 然后是四到七个数字，例如 135A1200 或 246FP317101 不想使用集合等，因为未知数太多

我正在考虑有一个循环来获取该值，从该值构建一个路径，同时在继续之前验证该路径是否存在，然后在到达最终子文件夹时，找到许多文件匹配值并做任何事情。我在子文件夹中循环和添加 X 时遇到问题，因为它们与所选值不匹配，而且并不总是知道 X 在不同子文件夹集中的位置。

135A1200-101 等于 \path\135\135A\135A1XXX\135A12XX\135A1200_S_01.file

或者

246FP317101-31 等于 \path\246\246F\246FP\246FP317101.file

\\路径\135\ 135A\ 135A0XXX\ 135A1XXX\ 135A10XX\ 135A11XX\ 135A12XX\ 135A1200_S_01.file 135A1200_S_02.file 135A1200_S_03.file 135A13XX\ 135A3XXX\ 135ASKXXX\ 135D\ 135F\ 135GGG\ 135LL\ \\路径\321\ \\路径\246\ 246F\ 246F13\ 246F14\ 246F15\ 246F16\ 246FF\ 246FP\ 246FP317101.file

这是我所拥有的，适用于一组更简单的文件和文件夹。

Public Sub pickFiles()
    Dim File As Variant
    Dim subPath As String

    File = Selection(1, 1).Value

    Select Case Left(File, 1)
    Case "Q"
        If Left(File, 6) = "Q11-12" Then
            subPath = "folder\QXX\Q11\" & Left(File, 6)
        ElseIf Left(File, 6) = "Q11-14" Then
            subPath = "folder\QXX\Q11\" & Left(File, 6)
        ElseIf Left(File, 6) = "Q11-22" Then
             subPath = "folder\QXX\Q11\" & Left(File, 6)
        Else
            subPath = "folder\QXX\" & Left(File, 3)
        End If
            openCompFile File, subPath
    Case "P"
        subPath = "folder\PXX\" & Left(File, 3)
        openCompFile File, subPath
    Case Else
        msgbox "That's not a valid file number", vbInformation
    End Select
End Sub

Private Sub openCompFile(ByRef File As Variant, ByRef subPath As String)
    Dim mainPath As String
    Dim fso As New FileSystemObject
    Dim Folder As Folder
    'Dim File As Variant
    Dim FileCollection As New Collection

    mainPath = "X:\folder\" & subPath

    Set Folder = fso.GetFolder(mainPath)

    For Each File In Folder.Files
        If Left(File.Name, 9) = Left(File, 9) Then FileCollection.Add File
    Next File

    If FileCollection.Count = 0 Then
        msgbox Left(File, 9) & " was not found.", vbInformation
    Else
        For Each File In FileCollection
            ShellExecute 0, "Open", File.Path, vbNullString, vbNullString, 1
        Next
    End If
End Sub

【问题讨论】：

当 openCompFile 将 ByRef File As Variant 传递给它，然后尝试将 Dim File As Variant 声明为局部变量时，它如何编译？

如果您在使用新代码时遇到问题，那么发布它可能比发布有效的版本更有用。

@Jeeped 你是对的。那不属于那里。

@Tim 这是我唯一的代码。寻找指导，只是展示我的尝试。

您说它适用于“更简单的文件集” - 对于更复杂的文件集，它会以什么方式失败，该集与工作集有何不同？只要您可以查看文件名并可靠地预测找到文件的路径，它应该是可以解决的：它仅取决于您需要遵循的规则的数量和复杂性。

【参考方案1】：

我不确定这会有多快，因为您似乎正在使用网络驱动器，但我的想法是使用 Command 内置的 DIR 函数来查找所有文件。 （不要将此与 VBA 的内置 DIR 命令混淆。VBA DIR 不会搜索子文件夹。CMD 的 DIR 会。）

我不能 100% 确定我确切地知道您的所有文件名是什么样的，但根据示例数据，连字符左侧的文件名部分似乎始终是文件名的一部分每个要打开的文件。例如：135A1200-101 应始终打开 3 个文件：135A1200_S_01.file、135A1200_S_02.file 和 135A1200_S_03.file，而 246FP317101-3 将打开 246FP317101.file。假设我了解文件命名约定，359AS12005-33 是否会打开这些文件 359AS12005_S_05 和 359AS12005.file？

如果是这样，试试这个代码：

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Function RunCMD(ByVal strCMD As String) As String
    'Runs the provided command
    Dim oShell As Object 'New wshShell
    Dim cmd As Object 'WshExec
    Dim x As Integer
    Const WshRunning = 0

    On Error GoTo wshError

    x = 0
    RunCMD = "Error"
    Set oShell = CreateObject("Wscript.Shell")
    Set cmd = oShell.Exec(strCMD)
    'Debug.Print strCMD
    'Stop
    Do While cmd.Status = WshRunning
        Sleep 100 'for 1/10th of a second
        x = x + 1
        If x > 1200 Then 'We've waited 2 minutes so kill it
            cmd.Terminate
            RunCMD = "Error: Timed Out"

        End If
    Loop

    RunCMD = cmd.StdOut.ReadAll & cmd.StdErr.ReadAll
    Set oShell = Nothing
    Set cmd = Nothing
    Exit Function

wshError:
    RunCMD = cmd.StdErr.ReadAll
    Resume Next
End Function

Sub FindFiles()
    Dim strSearchResults As String
    Dim strBaseFileName As String
    Dim strFileName As Variant
    Dim arrFileNames As Variant

    strBaseFileName = Left(Selection(1, 1).Value, InStr(1, Selection(1, 1).Value, "-", vbTextCompare))
    strSearchResults = RunCMD("cmd /c ""Dir X:\folder\" & strBaseFileName & "* /a:-d /b /d /s""")
    Debug.Print strSearchResults
    'Split the results into an array the can be looped through
    arrFileNames = Split(strSearchResults, vbCrLf, -1, vbTextCompare)
    Debug.Print UBound(arrFileNames)
    For Each strFileName In arrFileNames
        Debug.Print strFileName
    Next
End Sub

注意事项：FindFiles 子程序获取到第一个连字符之前的所有文本，并使用它在 EVERY 子目录中搜索以该文本字符串开头的 ANY 文件。如果这不是您想要的，那么希望这可以为您指明使用 Windows DIR 命令（与 VBA 的 DIR 命令相反，在这种情况下不起作用！）的相对有效的方法来找到解决方案。

【讨论】：

这很棒。让我稍微确定一下。