在阵列上使用VBA正则表达式

Question

I am writing a macro and the macro works fine, but I am trying to add some error handling to it so others are using it and an error occurs they are able to figure out what happened. The last problem I am having is I am using the Application.GetOpenFilename to open multiple files with multiselect = True. I am using a regex to match the file name and if the wrong file name is chosen then it displays an error message. If multiselect = False then I get no errors, but when it is equal to True I get a Type Mismatch error. I can only assume this is because when mutliselect = True the file is an array which the regex cannot handle. Is there a solution to this or can anyone point me to a better solution to handle the error. I have attached the VBA script as well.

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

When MultiSelect is true, file will always be a variant array, even if only a single file is selected. Therefore you must iterate through each element of the array in order to check it against your mask.

With regard to your mask, I would suggest using the Like operator as it seems simpler and will probably run faster. Note the # replacing the regex pattern [0-9] ) eg:

'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