Откройте несколько файлов Excel с правильными частичными именами файлов

Question

Привет всем,

Я хотел бы иметь код, который позволил бы мне выбрать несколько файлов (как показано выше); например. DataSource Quality, DataSource Security, DataSource Shipping, DataSource Warehouse. Кроме того, если выбрано имя файла DataSource Quality 2020, et c, оно все равно должно быть правильным выбором. То есть, если имя файла содержит имена, как показано на скриншоте выше, оно все равно должно считаться правильным.

Однако, если какой-либо из этих файлов выбран неправильно (неправильное частичное имя файла), должно появиться окно с сообщением " Нет / Выбран неправильный файл ". Я был бы очень признателен за любые материалы или помощь. Заранее спасибо!

В настоящее время у меня есть следующие коды:

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

Вы можете определить функцию для получения списка всех файлов в папке. В SO уже есть ответ на этот вопрос по следующей ссылке: { ссылка }

Ниже приведен тот же код.

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

После того, как это будет определено, вы можете использовать эту функцию в процедуре для l oop через все файлы, если они соответствуют вашим критериям, используя оператор 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. " Path " variable
2. " тест * "условие. Замените test на DataSource, если все ваши файлы начинаются с DataSource. НЕ удаляйте «*», так как это совпадение с подстановочными знаками, чтобы сопоставить что-либо после этого.
3. "*. Xlsm ". Это нужно для проверки типа файла. Измените xlsm на xlsx или xlsm или полностью удалите условие, если вам нужны все файлы excel.
4. В настоящее время процедура показывает только Msgbox для всех подходящих файлов, вам нужно заменить " MsgBox file"with" Workbooks.Open Path & "\" & file"

Просмотрите документацию LIKE Operator , чтобы узнать больше о сравнении шаблонов строк.

Answer 2

Я изменил ваш код, чтобы привести пример различий между различными требованиями к имени файла при выборе нескольких файлов:

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» или разрешить ему открывать любые найденные допустимые файлы вместо отклонения, если хотя бы один файл недействителен.

Answer 3

Вот мой код:

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

Возможно, он не такой элегантный, как у Гангулы, но все же он должен работать. Единственное замечание: я сохранил ваши предпочтения "все файлы" при открытии файлов. Тем не менее, я бы посоветовал отфильтровать его в .xlsm или .xls или в любой другой тип файлов Excel, которые вы должны открыть. Так же, как и Гангула.