MsAccess VBA ファイルダイアログを開く

Last modified date

MsAccess VBA ファイルダイアログを開く

MsAccessのVBAでファイル選択などのファイルダイアログを使いたい時に、色々コーディングをするのは面倒なので、1行の関数呼び出しで行えるようにしたいと思う。
複雑な設定をしたい場合はコーディングをする必要があるので、あくまで簡易的に使いたい時用のものを作る。

今回は「Microsoft Office X.X Object Library」を利用するが参照設定を行うと色々な環境で使いまわせなくなるため、実行時参照で作る。(参照設定を行わずに利用できるようにする。)

次の3つの関数を作ろうと思う。
– ファイル選択ダイアログ
– フォルダー選択ダイアログ
– 名前を付けて保存ダイアログ

ファイル選択ダイアログ

' Microsoft Office X.X Object Libraryを利用する
' 参照設定をするとバージョンが固定されてしまうため
' 参照設定は行わずに使う
Enum MKFileType
    AllFile = 1
    TextFile = 2
    ExcelFile = 3
    AccessDatabase = 4
End Enum


' ファイル選択ダイアログ
Function MKLibFileDialog(Optional fIndex As MKFileType = MKFileType.AllFile, Optional dTitle As String = "ファイル選択", Optional initPath As String = "")


    ' ファイルダイアログの準備
    Dim fDlg As Object
    Set fDlg = Application.FileDialog(3)    ' msoFileDialogFilePicker = 3

    fDlg.Title = dTitle ' ダイアログタイトル表示

    ' デフォルトの場所を設定
    If initPath = "" Then
        fDlg.initialfilename = CurrentProject.Path
    Else
        fDlg.initialfilename = initPath
    End If

    fDlg.AllowMultiSelect = False   ' 複数選択を許可しない

    ' 選択できるファイルを以下のように設定
    fDlg.Filters.Clear
    fDlg.Filters.Add "全てのファイル(*.*)", "*.*"
    fDlg.Filters.Add "テキストファイル(*.csv;*.txt)", "*.csv;*.txt"
    fDlg.Filters.Add "エクセルファイル(*.xls;*.xlsx)", "*.xls;*.xlsx"
    fDlg.Filters.Add "アクセスデータベース(*.mdb;*.accdb)", "*.mdb;*.accdb"

    ' 選択できるファイルの初期条件を設定
    If fIndex > fDlg.Filters.count Then
        fDlg.FilterIndex = 1
    Else
        fDlg.FilterIndex = fIndex
    End If


    ' ファイルダイアログを開く
    If fDlg.show Then
        MKLibFileDialog = fDlg.SelectedItems(1) ' 正常にファイルが選択された場合に、そのパスを返す
    Else
        MKLibFileDialog = ""    ' キャンセル時には空文字を返す
    End If


End Function

業務系のSEです。 比較的小規模な会社の業務システムを作っています。 趣味でiPhone・Androidアプリ開発を少々。 最近はダイエット・健康に気を使うようになり、とりあえず栄養学の勉強をしています。(勉強は良いから運動しろよ。。。)

Leave a Reply

Your email address will not be published. Required fields are marked *

Post comment