■ ファイル選択ダイアログ(GetFileDialog)

ファイル選択のダイアログを表示します
指定された初期表示ファイルのパスが見つからない場合は、デスクトップのパスを取得して
デスクトップを表示しています
フィルタを指定して、選択できるファイルの種類を限定することが可能です
ここでは *.txt と *.* の 2種類から、ファイルの種類を選択できるダイアログとしています
GetOpenFileName を使用すれば、ファイル選択ダイアログが表示されます
取得したファイル名の後ろは Null になっているので、削除する必要があります
ここでは、NullTrim という関数を自作して削除することを想定しています (掲載なし

Const MAX_PATH = 260                        ' ファイルパス長
                                            ' フィルタ文字列
Const FILTTER = "すべてのファイル (*.*)" & vbNullChar & "*.*" & vbNullChar & _
                "テキストファイル (*.txt)" & vbNullChar & "*.txt"
Const OFN_FILEMUSTEXIST = &H1000            ' 既存のファイルだけ入力できるようにする
Const OFN_HIDEREADONLY = &H4                ' 読み取り専用チェックボックスを表示しない

Type OPENFILENAME
    lStructSize         As Long             ' この構造体の長さ
    hWndOwner           As Long             ' 呼び出し元ウインドウハンドル
    hInstance           As Long             ' モジュールのインスタンスハンドル
    lpstrFilter         As String           ' フィルタ文字列
    lpstrCustomFilter   As String           ' ユーザー定義のフィルタ文字列のペア
    nMaxCustrFilter     As Long             ' lpstrCustomFilterのバッファサイズ
    nFilterIndex        As Long             ' フィルタコンボボックスの初期インデックス値
    lpstrFile           As String           ' 選択されたファイル名のフルパス
    nMaxFile            As Long             ' lpstrFileのバッファサイズ
    lpstrFileTitle      As String           ' 選択されたファイル名のタイトル
    nMaxFileTitle       As Long             ' lpstrFileTitleのバッファサイズ
    lpstrInitialDir     As String           ' 初期フォルダ名
    lpstrTitle          As String           ' ダイアログボックスのタイトル名
    flags               As Long             ' Flagsの値
    nFileOffset         As Integer          ' lpstrFileの最後の \までのオフセット値
    nFileExtension      As Integer          ' 拡張子までのオフセット値
    lpstrDefExt         As String           ' ファイル名の入力時、拡張子が省略された時の拡張子
    lCustrData          As Long             ' OSがlpfnHookで指定されたフック関数に渡すアプリケーション定義のデータ
    lpfnHook            As Long             ' ダイアログに送られるメッセージを処理するフック関数のポインタ
    lpTemplateName      As String
End Type

'******************************************************************************
'*  関数名:ファイル選択ダイアログ(GetFileDialog)
'*  引 数:呼び出しフォーム(o_form As Form)
'*      初期/選択ファイル名(w_fname As String)
'*  戻り値:確定/キャンセル(Boolean)
'*  機 能:ファイル選択ダイアログを表示し、ファイルを選択させる
'******************************************************************************
Public Function GetFile(o_form As Form, st_fname As String) As Boolean

    Dim l_ret             As Long           ' 戻り値
    Dim o_wscsh           As Object         ' WSHオブジェクト
    Dim st_path           As String         ' デスクトップパス
    Dim o_comdlg          As OPENFILENAME   ' コモンダイアログ構造体

    ' エラーが発生しても処理を続行する
    On Error Resume Next
    ' WSHオブジェクトを作成する
    Set o_wscsh = CreateObject("WScript.Shell")
    ' エラーが発生した場合
    If (Err <> 0) Then
        ' パスを初期化する
        st_path = ""

    Else
        ' デスクトップへのパスを取得
        st_path = o_wscsh.SpecialFolders("Desktop")
        ' WSHオブジェクトを解放する
        Set o_wscsh = Nothing

    End If
    ' エラー設定を無効にする
    On Error GoTo 0
    ' デフォルトファイルが指定されている場合
    If (Len(st_fname) < MAX_PATH) Then

        st_fname = st_fname & String$(MAX_PATH - Len(st_fname), Chr$(0))

    End If
    ' 構造体の長さを設定
    o_comdlg.lStructSize = Len(o_comdlg)
    ' 呼び出し元ウインドウハンドルを設定
    o_comdlg.hwndOwner = o_form.hWnd
    ' モジュールのインスタンスハンドルを設定
    o_comdlg.hInstance = App.hInstance
    ' フィルタ文字列を設定
    o_comdlg.lpstrFilter = FILTTER
    ' lpstrCustomFilterのバッファサイズを設定
    o_comdlg.nMaxCustrFilter = 0
    ' フィルタコンボボックスの初期インデックス値を設定
    o_comdlg.nFilterIndex = 0
    ' 選択されたファイル名のフルパスを設定
    o_comdlg.lpstrFile = st_fname
    ' lpstrFileのバッファサイズを設定
    o_comdlg.nMaxFile = MAX_PATH
    ' 選択されたファイル名のタイトルを設定
    o_comdlg.lpstrFileTitle = String$(MAX_PATH, Chr$(0))
    ' lpstrFileTitleのバッファサイズを設定
    o_comdlg.nMaxFileTitle = MAX_PATH + 1
    ' 初期フォルダ名を設定
    o_comdlg.lpstrInitialDir = st_path
    ' ダイアログボックスのタイトル名を設定
    o_comdlg.lpstrTitle = "ファイルを開く"
    ' Flagsの値を設定
    o_comdlg.flags = OFN_HIDEREADONLY Or OFN_FILEMUSTEXIST
    ' ファイル名の入力時、拡張子が省略された時の拡張子を設定
    o_comdlg.lpstrDefExt = ""
    ' ダイアログを表示する
    l_ret = GetOpenFileName(o_comdlg)
    ' キャンセルされた場合
    If (l_ret = 0) Then
        ' ファイル選択がキャンセルされたことを戻り値に設定
        GetFile = False
        ' ファンクションを抜ける
        Exit Function

    End If
    ' ファイル選択が確定されたことを戻り値に設定
    GetFile = True
    ' 選択ファイルのパスを後ろのNullを削除してセットします
    W_fname = NullTrim(o_comdlg.lpstrFile)

End Function