[VBA]ファイル選択ダイアログの表示

[はじめに]
・最近、Excelマクロを使う機会が増えたので、
　備忘録としてサンプルを掲載します。
　VBAの関数が使いにくいので、クラスモジュールにまとめてみました。
　.NETのOpenFileDialogクラスを真似して実装しているので、
　.NET開発者にとっては、お馴染みのインタフェースで使いやすいかと思います。

[ソース]

''' <summary> ''' クラスモジュール名：OpenFileDialog ''' ファイル選択ダイアログを制御するクラス ''' </summary> ''' <remarks></remarks> Option Explicit 'FileSystemPbject Private objFs As Object 'WScript.Shell Private objWs As Object 'タイトル Public Title As String '初期ディレクトリ Public InitialDirectory As String '[ファイルの種類]の選択肢 Public Filter As String '[ファイルの種類]の選択値 Public FilterIndex As Integer '複数選択の可否 Public MultiSelect As Boolean '選択したファイル名 Private m_FileNames() As String ''' <summary> ''' Initializeイベント（コンストラクタ） ''' </summary> ''' <remarks></remarks> Private Sub Class_Initialize()     Set objFs = CreateObject("Scripting.FileSystemObject")     Set objWs = CreateObject("WScript.Shell")          Call Clear End Sub ''' <summary> ''' Terminateイベント（デストラクタ） ''' </summary> ''' <remarks></remarks> Private Sub Class_Terminate()     Set objFs = Nothing     Set objWs = Nothing End Sub ''' <summary> ''' 初期化 ''' </summary> ''' <remarks></remarks> Public Sub Clear()          Me.InitialDirectory = Application.ThisWorkbook.path     Me.Filter = "すべてのファイル(*.*),*.*"     Me.FilterIndex = 1     Me.Title = "ファイルを選択してください"     Me.MultiSelect = True     ReDim m_FileNames(0) End Sub ''' <summary> ''' フィルターを設定 ''' </summary> ''' <param name="filterArray">フィルター文字列</param> ''' <remarks></remarks> Public Sub SetFilterList(ParamArray filterArray() As Variant)     Filter = Join(filterArray, ",") End Sub ''' <summary> ''' 選択したファイル名を取得する。 ''' </summary> ''' <remarks></remarks> Public Function GetSelectedFileNames() As String()     GetSelectedFileNames = m_FileNames End Function ''' <summary> ''' ファイル選択ダイアログを開く ''' </summary> ''' <returns>vbOK：ファイル選択、vbCancel：キャンセル</returns> ''' <remarks></remarks> Public Function ShowDialog() As VbMsgBoxResult     Dim resDlg As Variant     'カレントディレクトリを設定     objWs.CurrentDirectory = Me.InitialDirectory           'ファイル選択ダイアログを開く     resDlg = _          Application.GetOpenFilename( _               FileFilter:=Me.Filter, _               FilterIndex:=Me.FilterIndex, _               Title:=Me.Title, _               MultiSelect:=Me.MultiSelect _              )     If IsArray(resDlg) = False Then         If resDlg = False Then             'キャンセルした場合             ReDim m_FileNames(0)                          ShowDialog = vbCancel             Exit Function         End If     End If          ReDim m_FileNames(0)          'ファイル選択した場合     If IsArray(resDlg) = True Then         '複数選択の場合         Dim cnt_i As Integer                  For cnt_i = 1 To UBound(resDlg)             ReDim Preserve m_FileNames(cnt_i - 1)             m_FileNames(cnt_i - 1) = resDlg(cnt_i)         Next                  ShowDialog = vbOK         Exit Function     Else         '単一選択の場合         ReDim m_FileNames(0)         m_FileNames(0) = resDlg              ShowDialog = vbOK         Exit Function     End If      End Function

[VBA]ファイル選択ダイアログ

[ソース]

Private Sub CommandButton1_Click()          Dim ofd As New OpenFileDialog          With ofd         .Title = "ファイル選択ダイアログ（単一選択）"         .FilterIndex = 1         .MultiSelect = False         .SetFilterList "CSV(*.csv),*.csv", "すべてのファイル(*.*),*.*"              End With          'ファイル選択ダイアログを開く。     If ofd.ShowDialog() = vbOK Then                  Dim cntI As Integer         Dim fList() As String                  fList = ofd.GetSelectedFileNames()                  For cntI = 0 To UBound(fList)             MsgBox fList(cntI)         Next     Else         MsgBox "キャンセルしました"     End If     '終了処理     Set ofd = Nothing End Sub

[VBA]使用例