見出し画像

【Excel VBA】ユーザーに複数ファイルを選択させるコード

目的

昨日公開したファイル選択コードだと、1ファイルごとに選択処理をしなくてはならないため、大量のファイルを処理したい時に不便と感じた。
コードを修正して複数ファイルのパスを一次元配列に入れて処理できるように改良してみた。

完成コード

メインプロシージャ

Public Sub MainCode()
    
    Dim FilePaths As Variant
    FilePaths = Get_FilePath("C:", "処理するファイルを選択", True, vbCSVFile)
    If IsEmpty(FilePaths) Then Exit Sub 'キャンセル時は中断する
    
    Dim buf As Variant
    For Each buf In FilePaths
        MsgBox "選択ファイルパスは、" & buf & "です", vbExclamation, "メッセージ"
    Next buf

End Sub

配列で処理したいので、変数はバリアント型を選択。
単ファイルか、複数ファイルかを選択できるように引数3にBoolean型で条件分岐できるように工夫した。
一次元配列でファイルのパスが返ってくるので、For Each~Next文でループ処理することを前提にしています。

ファイルパス取得ファンクション

'**
'* ファイル選択画面を開き、選択したファイルパスを文字列型で返す関数
'* 引数1:FolderPath    {String型}  最初に表示するフォルダパス
'* 引数2:Caption       {String型}  ファイル選択画面のウインドウ右上に表示するコメント
'* 引数3:[MultiSelect] {Boolean型} ファイルの複数選択可否を指定。未指定の場合は複数選択不可。
'* 引数4:[FileType]    {Enum型}    拡張子でフィルターしたい場合に指定。未指定の場合はすべて表示
'* 返り値:              {String型 or Variant型}  ユーザーが選択したファイルのパスを返す。
'**
Private Function Get_FilePath(ByVal FolderPath As String, _
                                  ByVal Caption As String, _
                     Optional ByVal MultiSelect As Boolean = False, _
                        Optional ByVal FileType As EnumFileType = 0) As Variant
    '準備
    Dim Key As Variant
    Key = Get_FileFilterMethod(FileType)   '拡張子フィルタ条件のセット
    Dim FileDialog As FileDialog
    Set FileDialog = Application.FileDialog(msoFileDialogFilePicker)
    
    '処理
    Dim Output As Variant
    With FileDialog
    
        'FileDialogの設定
        .Filters.Clear                          '初期化
        .InitialFileName = FolderPath & "\"     '最初に表示するフォルダパス
        .Title = Caption                        'ウインドウ左上のキャプションを設定
        .Filters.Add Key(0), Key(1), 1          '拡張子のフィルタ設定
        .AllowMultiSelect = MultiSelect         '複数ファイルを選択可とするか否か
        
        'FileDialogの表示、Outputに選択結果を格納
        Select Case MultiSelect
            Case True '複数ファイル選択の場合
                If .Show Then
                    ReDim Output(1 To .SelectedItems.Count) As Variant
                    Dim I As Long
                    For I = 1 To .SelectedItems.Count
                        Output(I) = .SelectedItems(I)
                    Next I
                Else
                    Exit Function
                End If
            Case False '単独ファイル選択の場合
                If .Show Then
                    Output = .SelectedItems(1)
                Else
                    Exit Function
                End If
        End Select
        
    End With
    
    '出力
    Get_FilePath = Output

End Function

複数選択可否を選択可能としたため、FileDialogの表示部分を条件分岐処理するため、少し複雑になってしまいました。
If .Show Then~ の部分は別プロシージャにした方が読みやすいかもしれませんね。

ファイルダイアログの拡張子フィルタ条件生成ファンクション

Option Explicit

Public Enum EnumFileType
    vbCSVFile = 1
    vbTextFile = 2
    vbExcelFile = 3
End Enum

'**
'* EnumFileTypeから拡張子のフィルター条件を一次元配列に入れて返す関数
'* 引数1:FileType {Enum型}    拡張子のフィルター番号[EnumFileType]を指定
'* 返り値:         {Variant型} 拡張子のフィルター条件を一次元配列で返す
'**
Private Function Get_FileFilterMethod(ByVal FileType As EnumFileType) As Variant
    
    Dim Output As Variant
    
    '処理
    Select Case FileType
        Case 1: Output = Array("CSV File", "*.csv")
        Case 2: Output = Array("Text File", "*.txt")
        Case 3: Output = Array("Excel File", "*.xls;*.xlsx")
        Case Else: Output = Array("All File", "*.*")
    End Select

    '出力
    Get_FileFilterMethod = Output
    
End Function

こちらのコードは昨日のまま、特にいじってません。

いいなと思ったら応援しよう!