在數組上使用VBA正則表達式

Question

我正在寫一個宏並且宏能正常工作，但我正在嘗試向它添加一些錯誤處理，以便其他人正在使用它併發生錯誤，因此他們能夠弄清楚發生了什麼。我遇到的最後一個問題是我使用Application.GetOpenFilename以multiselect = True打開多個文件。我正在使用正則表達式來匹配文件名，如果選擇了錯誤的文件名，則會顯示一條錯誤消息。如果multiselect = False，那麼我沒有得到任何錯誤，但是當它等於True時，我得到一個Type Mismatch錯誤。我只能假設這是因爲當mutliselect = True時，該文件是正則表達式無法處理的數組。有沒有解決這個問題的方法，或者任何人都可以指出一個更好的解決方案來處理錯誤。我也附加了VBA腳本。

Sub DataImport_Loop() 
    Dim nom As String 
    Dim wb As Excel.Workbook 
    Dim i, j, k, m, n, file As Variant 
    Dim strPattern As String: strPattern = "Strain End Point [0-9] - FEA Loop - Loading - (Timed)" 'File Pattern 
    Dim regex As Object 
    Set regex = CreateObject("VBScript.RegExp") 
    'Turns Screen Updating and Alert Displays off 
    Application.ScreenUpdating = False 
    Application.DisplayAlerts = False 
    nom = ActiveWorkbook.Name 
    'takes user straight into necessary folder 
    If CurDir() <> CurDir("J:") Then 
     ChDrive "J:" 
     ChDir "J:FEA Material Data" 
    End If 
    'Number of specimens tested 
    For i = 1 To 5 
     'Allows user to select multiple files to open 
     file = Application.GetOpenFilename(_ 
      FileFilter:="Text Files (*.csv), *.csv", _ 
      MultiSelect:=True) 
     'If no file selected, stop data import and display error message 
     If Not IsArray(file) Then 
      MsgBox ("You only imported " & (i - 1) & " Specimens.") 
      Exit Sub 
      'Sets patteren to check if correct file 
      With regex 
       .Pattern = strPattern 
      End With 
      'Checks set pattern, displays error message if not correct file 
      If regex.Test(file) = False Then 
       MsgBox ("Select Loading Only") 
       Exit Sub 
      End If 
     Else 
      Counter = 1 

      While Counter <= UBound(file) 
       j = (2 * i) - 1 
       Workbooks.Open file(Counter) 
       Set wb = Workbooks("Strain End Point " & Counter & " - FEA Loop - Loading - (Timed).csv") 
       'End of column, needs + 3 to account for first 3 unused cells 
       k = Range("F4", Range("F4").End(xlDown)).Count + 3 
       'Loops through data, deletes negative values 
       For m = 4 To k 
        If Range("F" & m).value < 0 Or Range("F" & m).Offset(0, 1) < 0 Then 
         Range("F" & m).Delete 
         Range("F" & m).Offset(0, 1).Delete 
         'If cell is deleted, rechecks new value 
         m = m - 1 
        End If 
       Next m 
       Range("F4:G" & k).Copy 
       Workbooks(nom).Sheets(Counter + 1).Cells(4, j).PasteSpecial 
       wb.Close 
       'Opens next file 
       Counter = Counter + 1 
      Wend 
     End If 
    Next i 
    'Turns Screen Updating and Alert Displays back on 
    Application.DisplayAlerts = True 
    Application.ScreenUpdating = True 
End Sub 

Answer 1

當MultiSelect爲真時，將file總是是變體陣列，即使只有一個單獨的文件被選擇。因此，您必須遍歷數組中的每個元素，以便根據您的掩碼進行檢查。

關於你的面具，我會建議使用Like運營商，因爲它看起來更簡單，可能會運行得更快。 注意#替換正則表達式模式[0-9]）例如：

'Checks set pattern, displays error message if not correct file 
Const strPattern as String = "Strain End Point # - FEA Loop - Loading - (Timed)" 'File Pattern 
    For I = LBound(file) To UBound(file) 
     If Not file(I) Like strPattern Then 
       MsgBox ("Select Loading Only") 
       Exit Sub 
     End If 
    Next I