hiko-blog

VBA業務改善

MENU

ファイル選択 ダイアログ活用

Sub ファイル選択()
    ' シート"Sheet1"をアクティブにしてA1セルを選択
    Sheets("Sheet1").Select
    Range("A1").Select
    
    ' ファイル選択ダイアログを表示してユーザーにファイルを選ばせる
    Dim filePath As String
    
    filePath = Application.GetOpenFilename("All Files (*.*), *.*," & _
                                           "Excel Files (*.xls; *.xlsx), *.xls; *.xlsx," & _
                                           "CSV Files (*.csv), *.csv," & _
                                           "Text Files (*.txt), *.txt," & _
                                           "PDF Files (*.pdf), *.pdf," & _
                                           "ZIP Files (*.zip), *.zip", , "Select a File")
    
    ' ユーザーがキャンセルを押した場合
    If filePath = "False" Then Exit Sub
    
    ' 選択されたファイルパスをA1セルに転記
    Range("A1").Value = filePath
End Sub

 

Sub ファイル複数選択()
    ' ファイル選択ダイアログを表示してユーザーに複数のファイルを選ばせる
    Dim filePaths As Variant
    Dim i As Integer
    
    filePaths = Application.GetOpenFilename("All Files (*.*), *.*," & _
                                            "Excel Files (*.xls; *.xlsx), *.xls; *.xlsx," & _
                                            "CSV Files (*.csv), *.csv," & _
                                            "Text Files (*.txt), *.txt," & _
                                            "PDF Files (*.pdf), *.pdf," & _
                                            "ZIP Files (*.zip), *.zip", , "Select Files", MultiSelect:=True)
    
    ' ユーザーがキャンセルを押した場合
    If IsArray(filePaths) Then
        ' シート"Sheet1"をアクティブにする
        Sheets("Sheet1").Select
        
        ' 選択されたファイルパスをA1から順に転記
        For i = LBound(filePaths) To UBound(filePaths)
            Cells(i, 1).Value = filePaths(i)
        Next i
    Else
        MsgBox "No files were selected."
    End If
End Sub