使用基於單元格值的excel VBA打開文件，路徑從同一值開始動態組成

Question

這是目標。 用戶從網絡驅動器打開的只讀工作簿。 選擇一個具有文件名的單元格，然后單擊宏按鈕，該宏按鈕將查找並打開與該單元格值匹配的每多少個文件。

實現該結果的最有效方法是什么？ 請記住：

• 用戶不想每次打開工作簿時都等待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

Answer 1

我不確定這將有多快，因為您似乎正在使用網絡驅動器，但是我的想法是使用Command的內置DIR函數查找所有文件。 （不要將此與VBA的內置DIR命令混淆。VBADIR不會搜索子文件夾。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子獲取所有文本直到第一個連字符，並使用該文本在每個子目錄中搜索以該文本字符串開頭的任何文件。 如果這不是您想要的，那么希望它可以為您提供一種相對有效的方法，該方法使用Windows DIR命令（而不是在這種情況下不起作用的VBA的DIR命令！）來找到解決方案。