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

GetOpenFilename(単一ファイル)

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

GetOpenFilename(複数ファイル)

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

FileDialog(単一ファイル)

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

なんちゃって簡易版

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

コメント