VBA ファイルの選択ダイアログ

Sub ファイル選択01()
    Dim fName As Variant
    fName = Application.GetOpenFilename(FileFilter:="Excelファイル,*.xls*", Title:="ファイルを選択してね")
    Debug.Print fName
    If fName = False Then
        MsgBox "キャンセルされました"
        Exit Sub
    End If
    
    '処理を記述
    
    '例：選択されたファイルを開いて利用する場合
    Application.ScreenUpdating = False
    Dim tWb As Workbook
    Set tWb = Workbooks.Open(fName)
    Debug.Print tWb.Name
    '......
    tWb.Close SaveChanges:=False '保存する場合はTrue
    Application.ScreenUpdating = True
    Set tWb = Nothing
End Sub

Sub ファイル選択02()
    Dim fNameArr As Variant
    
    fNameArr = Application.GetOpenFilename(FileFilter:="Excelファイル,*.xls*", Title:="ファイルを選択してね", MultiSelect:=True)
    
    If Not IsArray(fNameArr) Then
        MsgBox "キャンセルされました"
        Exit Sub
    End If
    
    '処理を記述
    
    '選択されたファイルを開いて利用する場合
    Application.ScreenUpdating = False
    Dim tWb As Workbook
    Dim i As Long
    
    For i = LBound(fNameArr) To UBound(fNameArr)
        Set tWb = Workbooks.Open(fNameArr(i))
        Debug.Print tWb.Name
        '......
        DoEvents
        tWb.Close SaveChanges:=False '保存する場合はTrue
    Next i
    '
    Application.ScreenUpdating = True
    Set tWb = Nothing
End Sub

Sub ファイル選択03()
    Dim fName As String
    Dim tWb As Workbook
    Application.ScreenUpdating = False
    With Application.FileDialog(msoFileDialogFilePicker)
        .Filters.Clear
        .Filters.Add "Excelファイル", "*.xls*"
        .InitialFileName = ThisWorkbook.Path
        .AllowMultiSelect = False
        .Title = "ファイルの選択"
        
        If .Show = True Then
            fName = .SelectedItems(1)
            Debug.Print "選択フォルダは" & fName
            Set tWb = Workbooks.Open(fName)
            Debug.Print tWb.Name
            '......
            DoEvents
            tWb.Close SaveChanges:=False '保存する場合はTrue
        Else
            MsgBox "キャンセルされました"
        End If
        
    End With
    Application.ScreenUpdating = True
    Set tWb = Nothing
End Sub

' === - Type定義 ===
Public Type FileSelectSingleResult
    IsSuccess As Boolean
    filePath As String
    ErrorMessage As String
End Type

Public Type FileSelectMultiResult
    IsSuccess As Boolean
    FilePaths() As String
    ErrorMessage As String
End Type

Public Type FileOpenResult
    IsSuccess As Boolean
    OpenedBook As Workbook
    ErrorMessage As String
End Type

' === - (1)：1ファイル選択（パスのみ） ===
Public Function zfSelectSingleExcelFile(ByVal dialogTitle As String) As FileSelectSingleResult
    Dim fd As FileDialog
    Dim result As FileSelectSingleResult

    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    With fd
        .Title = dialogTitle
        .InitialFileName = ThisWorkbook.Path & "\"
        .Filters.Clear
        .Filters.Add "Excelファイル", "*.xls*"
        .AllowMultiSelect = False

        If .Show = -1 Then
            result.IsSuccess = True
            result.filePath = .SelectedItems(1)
        Else
            result.IsSuccess = False
            result.filePath = ""
            result.ErrorMessage = "キャンセルされました"
        End If
    End With
    zfSelectSingleExcelFile = result
End Function

' === - (2)：複数ファイル選択（配列で返す） ===
Public Function zfSelectMultiExcelFiles(ByVal dialogTitle As String) As FileSelectMultiResult
    Dim fd As FileDialog
    Dim result As FileSelectMultiResult
    Dim i As Long

    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    With fd
        .Title = dialogTitle
        .InitialFileName = ThisWorkbook.Path & "\"
        .Filters.Clear
        .Filters.Add "Excelファイル", "*.xls*"
        .AllowMultiSelect = True

        If .Show = -1 Then
            ReDim result.FilePaths(1 To .SelectedItems.Count)
            For i = 1 To .SelectedItems.Count
                result.FilePaths(i) = .SelectedItems(i)
            Next i
            result.IsSuccess = True
        Else
            result.IsSuccess = False
            result.ErrorMessage = "キャンセルされました"
        End If
    End With
    zfSelectMultiExcelFiles = result
End Function

' === - (3)：1ファイル選択し、ブックを開く ===
Public Function zfTryOpenExcelFile(ByVal dialogTitle As String) As FileOpenResult
    Dim fd As FileDialog
    Dim filePath As String
    Dim result As FileOpenResult
    Dim wb As Workbook

    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    With fd
        .Title = dialogTitle
        .InitialFileName = ThisWorkbook.Path & "\"
        .Filters.Clear
        .Filters.Add "Excelファイル", "*.xls*"
        .AllowMultiSelect = False

        If .Show = -1 Then
            filePath = .SelectedItems(1)
            On Error Resume Next
            Set wb = Workbooks.Open(filePath)
            On Error GoTo 0
            If wb Is Nothing Then
                result.IsSuccess = False
                result.ErrorMessage = "ファイルのオープンに失敗しました"
            Else
                result.IsSuccess = True
                Set result.OpenedBook = wb
            End If
        Else
            result.IsSuccess = False
            result.ErrorMessage = "キャンセルされました"
        End If
    End With
    zfTryOpenExcelFile = result
End Function

’------------------実行プロシージャ------------------------------
Sub Test_①()
    Dim res As FileSelectSingleResult
    res = zfSelectSingleExcelFile("1つExcelファイルを選んでください")
    If res.IsSuccess Then
        Debug.Print "選択されたファイル：" & res.filePath
    Else
        Debug.Print "選択なし：" & res.ErrorMessage
    End If
End Sub

Sub Test_②()
    Dim res As FileSelectMultiResult
    Dim i As Long
    res = zfSelectMultiExcelFiles("複数Excelファイルを選んでください")
    If res.IsSuccess Then
        For i = LBound(res.FilePaths) To UBound(res.FilePaths)
            Debug.Print res.FilePaths(i)
        Next i
    Else
         Debug.Print "選択なし：" & res.ErrorMessage
    End If
End Sub

Sub Test_③()
    Dim res As FileOpenResult
    res = zfTryOpenExcelFile("Excelファイルを開いてください")
    If res.IsSuccess Then
        Debug.Print "開いたファイル名：" & res.OpenedBook.Name
        Debug.Print "開いたファイルパス：" & res.OpenedBook.FullName
    Else
        Debug.Print "選択なし：" & res.ErrorMessage
    End If
End Sub

Sub Sample()
    Dim OpenFileName As Variant
    OpenFileName = Application.GetOpenFilename("Microsoft Excelブック,*.xls?")
    If OpenFileName <> False Then
        Workbooks.Open OpenFileName
    Else
        MsgBox "キャンセルされました"
    End If
End Sub