根据部分文件名打开多个 Excel 文件

Question

我想选择多个文件（如图）；例如。 “数据源质量”、“数据源安全”、“数据源运输”、“数据源仓库”。

补充一点，如果选择的文件名是“DataSource Quality 2020”等，它应该仍然是一个有效的选择。意思是说，只要文件名包含上面截图中显示的名称，它仍然应该被认为是正确的。

但是，如果选择的任何文件有误（部分文件名错误），则应该有一个消息框显示“No/Wrong file selected”。

Dim hasRun As Boolean

Sub RunOnlyOnce()

    Application.DisplayAlerts = True

    If hasRun = False Then
        
        Dim fNameAndPath As Variant
        fNameAndPath = Application.GetOpenFilename(FileFilter:="All Files (*.*), *.*", Title:="Select Files To Be Opened", MultiSelect:=True)
        Debug.Print fNameAndPath
        Debug.Print Dir(fNameAndPath)

        If Dir(fNameAndPath) = "DataSource.xlsx" Then
            Workbooks.Open Filename:=fNameAndPath
            hasRun = True
            Exit Sub
        Else
            MsgBox "No/Wrong file selected. ", vbExclamation, "Oops!"
            ThisWorkbook.Saved = False
            Application.Quit

        End If
    End If
    
End Sub

Answer 1

您可以定义一个函数来获取文件夹中所有文件的列表。在下面的链接中已经有一个答案：https://stackoverflow.com/a/31428399/6908282

下面是相同的代码。

Public Function listfiles(ByVal sPath As String)
    
    Dim vaArray     As Variant
    Dim i           As Integer
    Dim oFile       As Object
    Dim oFSO        As Object
    Dim oFolder     As Object
    Dim oFiles      As Object

    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set oFolder = oFSO.GetFolder(sPath)
    Set oFiles = oFolder.Files

    If oFiles.Count = 0 Then Exit Function

    ReDim vaArray(1 To oFiles.Count)
    i = 1
    For Each oFile In oFiles
        vaArray(i) = oFile.Name
        i = i + 1

    Next

    listfiles = vaArray
    
  End Function

定义后，您可以在过程中使用此函数循环所有文件，如果它们符合您的条件，使用LIKE Operator 并打开符合条件的文件。请参阅下面的示例

Public Sub abc()
Dim Path As String, file As Variant, i As Integer

Path = "D:\Parent Folder\Sub Folder"
i = 1
For Each file In listfiles(Path)
 If file Like "test*" And file Like "*.xlsm" Then MsgBox file  ' replace "MsgBox file" with "Workbooks.Open Path & "\" & file"
    i = i + 1
 Next


End Sub

注意：在上面的代码中，请确保编辑 4 件事

1. “路径”变量
2. “测试*”条件。如果所有文件都以 DataSource 开头，则将 test 替换为 DataSource。不要删除“*”，因为这是匹配之后的任何内容的通配符。
3. “*.xlsm”。这是检查文件的文件类型。如果您想要所有 excel 文件，请将 xlsm 更改为 xlsx 或 xlsm 或完全删除条件。
4. 目前，该程序仅显示所有匹配文件的 Msgbox，您需要将“MsgBox file”替换为“Workbooks.Open Path & “\” & file"

查看LIKE Operator documentation 了解有关比较字符串模式的更多信息。

Answer 2

这是我的代码：

Sub SubOpenDataSourceFiles()

    'Declarations.
    Dim WrkMotherWorkbook As Workbook
    Dim VarFiles As Variant
    Dim IntCounter01 As Integer
    Dim StrFileName As String
    Dim StrMarker As String

    'Setting variables.
    StrMarker = "DataSource"
    Set WrkMotherWorkbook = ActiveWorkbook

    'Request the user what files to open.
    VarFiles = Application.GetOpenFilename(FileFilter:="All Files (*.*), *.*", _
                                           Title:="Select Files To Be Opened", _
                                           MultiSelect:=True _
                                          )

    'Checking if it has been selected any file.
    On Error GoTo No_File_Selected
    IntCounter01 = UBound(VarFiles)
    On Error GoTo 0

    'Scrolling through the files.
    For IntCounter01 = 1 To UBound(VarFiles)

        'Setting the variable in order to analyse the file name.
        StrFileName = Split(VarFiles(IntCounter01), "\")(UBound(Split(VarFiles(IntCounter01), "\")))

        'Checking if the left part of the file name differs from StrMarker.
        If Left(StrFileName, Len(StrMarker)) <> StrMarker Then
            'If it does differ, a message box pops up.
            MsgBox "Unauthorized file.", vbExclamation, StrFileName
        Else
            'If it doesn't differ, it opens the file (assuming it's not a corrupted file).
            Workbooks.Open Filename:=CStr(VarFiles(IntCounter01))
        End If

    Next

    'Activating WrkMotherWorkbook.
    WrkMotherWorkbook.Activate

No_File_Selected:

End Sub

它可能不如 Gangula 的优雅，但它仍然可以工作。唯一一点：我在打开文件时保持了您的“所有文件”偏好。我仍然建议将其过滤为 .xlsm 或 .xls 或您应该打开的任何类型的 excel 文件。就像 Gangula 所做的那样。

Answer 3

我已经修改了您的代码，以举例说明在选择多个文件时区分不同的文件名要求：

Sub OpenOnlyValidFiles()
    fNameAndPath = Application.GetOpenFilename(FileFilter:="All Files (*.*), *.*", Title:="Select Files To Be Opened", MultiSelect:=True)

    AllFilesAreValid = True
    For Each FullPathAndName In fNameAndPath  'Test all files to see if they meet requirements
        ' Test only filename and not the path
        fName = Split(FullPathAndName, Application.PathSeparator)(UBound(Split(FullPathAndName, Application.PathSeparator)))
        If Not (fName Like "DataSource Quality*") And _
           Not (fName Like "DataSource Security*") And _
           Not (fName Like "DataSource Shipping*") And _
           Not (fName Like "DataSource Warehouse*") And _
           Not (fName Like "GoodFile*") Then
            AllFilesAreValid = False
        End If
     Next

    If AllFilesAreValid Then 'If all files meet the requirements then open them in Notepad
        For Each FullPathAndName In fNameAndPath
            Shell "NOTEPAD.EXE " & FullPathAndName
        Next
        MsgBox (UBound(fNameAndPath) & " valid files found and opened in notepad")
    Else
        MsgBox ("At least one file was not valid. No files opened.")
    End If
End Sub

创建一个文件夹来测试其中的文件，例如：

DataSource Excluded Stuff.txt
DataSource Quality.txt
DataSource Security.txt
DataSource Security 2020.txt
DataSource Shipping.txt
DataSource Warehouse.txt
DataSource Warehouse 2019.txt
DataSource Warehouse 2020.txt
GoodFile.txt
BadFile.txt
GoodFile 2020.txt
BadFile 2020.txt

您可以修改代码以检查“.xlsx”或“.xlsm”扩展名，或者让它打开找到的任何有效文件，而不是在一个文件无效时拒绝。