【VBA】ファイル選択ダイアログ(単一・複数ファイル)
<機能>
(1)単一ファイル選択ダイアログを表示
(2)複数ファイル選択ダイアログを表示
<動作検証>
Microsoft Office 2016
<実行イメージ>
設定は
・ダイアログタイトル
・単一ファイル/複数ファイル選択
・ファイルフィルター(txtまたはcsv)
・初期表示フォルダ
(エクセルブックと同じフォルダを指定)
複数ファイル選択結果を表示したところ
<使い方>
適当なところにソースを貼り付けてください
ファイルを選択する() を実行すると処理を開始します
'/********************************************************
'/* ファイル選択ダイアログ(単一/複数ファイル選択)を表示する
'/* 引数:
'/* strDefault 初期表示フォルダ
'/* isMulti trueのとき複数ファイル選択可能
'/* 戻り値:
'/* 選択されたときtrue、キャンセルされたときfalse
'/* strSelect 選択されたファイルフルパス(参照)
'/********************************************************
Function SelectFile(ByVal strDefault As String, _
ByVal isMulti As Boolean, _
ByRef strSelect() As String) As Boolean
Dim sItem As Variant
SelectFile = False
ReDim strSelect(0)
strSelect(0) = ""
'//ファイル選択ダイアログを表示
'//DialogTypeは以下の通りです(詳細はMSDN参照)
'//msoFileDialogFilePicker ファイルの参照
'//msoFileDialogFolderPicker フォルダの参照
'//msoFileDialogOpen ファイルを開く
'//msoFileDialogSaveAs 名前を付けて保存
With Application.FileDialog(msoFileDialogFilePicker)
'複数選択不可(単一/複数ファイル選択)
.AllowMultiSelect = isMulti
'初期表示フォルダ
.InitialFileName = strDefault & "¥"
'ファイルフィルター(txt/csvフィルターを一番上に表示)
.Filters.Add "テキストファイル", "*.txt;*.csv", 1
'エクセルファイル選択のとき
'.Filters.Add "MSエクセルファイル", "*.xls*", 1
'タイトルを指定
.Title = "ファイル選択ダイアログサンプル"
'ファイルが選択された
If .Show = True Then
For Each sItem In .SelectedItems
If strSelect(0) <> "" Then
'配列を拡張
ReDim Preserve strSelect(UBound(strSelect) + 1)
End If
strSelect(UBound(strSelect)) = sItem
SelectFile = True
Next sItem
Else
.Execute
End If
End With
End Function
'/********************************************************
'/* ファイル選択ダイアログ呼び出しサンプル
'/********************************************************
Public Sub ファイルを選択する()
Dim strSelect() As String
Dim wksel As Variant, wkmsg As String
'//(1)単一ファイルを選択する
If Not SelectFile(ThisWorkbook.Path, False, strSelect()) Then
MsgBox "ファイル選択がキャンセルされました", vbCritical
GoTo multiselect
End If
'//選択された単一ファイルを表示
MsgBox "選択ファイル:" & vbCrLf & strSelect(0), vbInformation
multiselect:
'//(2)複数ファイルを選択する
If Not SelectFile(ThisWorkbook.Path, True, strSelect()) Then
MsgBox "ファイル選択がキャンセルされました", vbCritical
Exit Sub
End If
'//選択された複数ファイルを表示
wkmsg = ""
For Each wksel In strSelect
wkmsg = wkmsg & vbCrLf & wksel
Next wksel
MsgBox "選択ファイル:" & wkmsg, vbInformation
End Sub
よろしければポチッと押してください