Access2003以降で Folder/File 選択ダイアログを使う
Access のマクロは、テキストファイルの読み込みは[テキスト変換]、Excelワークシートの読み込みは[ワークシート変換]アクションが使えるが、何れもファイル名を決め打ちしないといけないので、実行時に任意のテキストファイルやワークシートを読み込むことができない。
そこでAccessVBAからファイル選択ダイアログを呼び出してファイルやフォルダのパスを返すユーザ関数が必要になる。
AccessVBAでファイル選択ダイアログを使う方法はいくつかあるがAccess2002からFileDialogオブジェクトが使えるようになったので、これを使う。
*1
ただし事前に参照設定でMicrosoft Office 10.0 Object Library以上を参照するように設定しなければならない。
自分で使うためだけならさほど問題ではないのだけど、作成したデータベースファイルを共用するといろいろ面倒なことができてくる。
まず、Accessのバージョンによっては参照設定済のデータベースファイルでObject Libraryが参照不可になる場合がある。例えばAccess2003のOffice Object Libraryは、ServicePack 3とそれ以前ではバージョンが異なるためどちらかのバージョンで参照設定されていると、同じAccess2003でもObject Libraryが参照不可になって参照設定をやり直さなければならない。これは一般人でも説明すれば解決できる問題だが、逆に言えば説明もなしにただ渡されただけでは手も足も出ない事態となる。
そこでFileDialogオブジェクトを実行時に呼び出すように VBA コードを記述して参照設定の問題を回避したのが以下の関数。
まず、フォルダ選択ダイアログのための関数。戻り値はフォルダパス。
Function getFolderPicker(Optional dlgTitle As String = "フォルダ選択") As String
' 【引数】
' dTitle: daialog title string(default:"フォルダ選択")
' 【戻り値】
' Cancel)Null String("")
' OK ) folder path string
Const msoFileDialogFolderPicker As Integer = 4
Dim fDlg As Object
Set fDlg = Application.FileDialog(msoFileDialogFolderPicker)
fDlg.Title = dlgTitle
fDlg.InitialFileName = CurrentProject.Path
If fDlg.Show Then getFolderPicker = fDlg.SelectedItems(1) Else getFolderPicker = ""
End Function使い方はこんな感じ。
' Visual Basic Editor の Immediate Window に結果を表示(Debug.Print)
Function test_getFolderPicker()
Debug.Print getFolderPicker()
Debug.Print getFolderPicker("フォルダを選んでください")
End Function次にファイル選択ダイアログのための関数。
目的は Access マクロの[テキスト変換]や[ワークシート変換]アクションに渡すためのファイルパスを取得するためなので、予め[全てのファイル][テキストファイル][Excelワークシート][Accessデータベース]の FileFilter を用意し、引数として FilterIndex を指定するだけにしている。この時、範囲外の FilterIndex を指定すると[全てのファイル] FileFilter が選択されるようにしている。
.FileDialog(msoFileDialogFilePicker)
上記メソッドは、選択可能な値より小さな FilterIndex が与えられたときは一番先頭の FilteFIlter が指定され、選択可能な値より大きな FilterIndex が与えられたときは、一番最後の FileFilter が選択されるが、自作関数では .getOpneFileDialog メソッドに振る舞いを合わせた。
戻り値には選択されたファイルパスを返す。
Function getFilePicker(fIndex As Integer, Optional dTitle As String = "ファイル選択")
' 【引数】
' fIindex:
' 1>→All Files(*.*)
' 1→All Files(*.*)
' 2→Text Files(*.csv;*.txt)
' 3→Excel Files(*.xls)
' 4→Access Database(*.mdb)
' 4<→All Files(*.*)
' dTitle:
' daialog title string(default:"ファイル選択")
' 【戻り値】
' Cancel)Null String("")
' OK ) file path string
Const msoFileDialogFilePicker As Integer = 3
Dim fDlg As Object
Set fDlg = Application.FileDialog(msoFileDialogFilePicker)
fDlg.Title = dTitle
fDlg.InitialFileName = CurrentProject.Path
fDlg.AllowMultiSelect = False
fDlg.Filters.Clear
fDlg.Filters.Add "All Files(*.*)", "*.*"
fDlg.Filters.Add "Text Files(*.csv;*.txt)", "*.csv;*.txt"
fDlg.Filters.Add "Excel Files(*.xls)", "*.xls"
fDlg.Filters.Add "Access Databases(*.mdb)", "*.mdb"
If fIndex > fDlg.Filters.Count Then fDlg.FilterIndex = 1 Else fDlg.FilterIndex = fIndex
If fDlg.Show Then getFilePicker = fDlg.SelectedItems(1) Else getFilePicker = ""
End Function使い方はこんな感じ
' Visual Basic Editor の Immediate Window に結果を表示(Debug.Print)
Function test_getFilePicker()
Debug.Print getFilePicker(1) ' *.*
Debug.Print getFilePicker(2) ' *.csv;*.txt
Debug.Print getFilePicker(3) ' *.xls
Debug.Print getFilePicker(4) ' *.mdb
Debug.Print getFilePicker(10) ' *.*
Debug.Print getFilePicker(2, "テキストファイルを選んでください")
End Function
