Home >> ヒント・サンプル集 >> プログラムサンプル >> (VBA[関数] ファイルを開く ダイアログ

<VBA> [関数] ファイルを開く ダイアログ
ファイルを選択するためのダイアログです

    Declare PtrSafe Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Boolean

    Type OPENFILENAME
        lStructSize As Long
        hwndOwner As LongPtr
        hInstance As LongPtr
        lpstrFilter As String
        lpstrCustomFilter As String
        nMaxCustrFilter As Long
        nFilterIndex As Long
        lpstrFile As String
        nMaxFile As Long
        lpstrFileTitle As String
        nMaxFileTitle As Long
        lpstrInitialDir As String
        lpstrTitle As String
        Flags As Long
        nFileOffset As Integer
        nFileExtension As Integer
        lpstrDefExt As String
        lCustrData As Long
        lpfnHook As LongPtr
        lpTemplateName As String
        pvReserved As LongPtr
        dwReserved As Long
        FlagsEx As Long
    End Type

    Type MSA_OPENFILENAME
        strFilter As String           ' [ファイルを開く] ダイアログ フィルタに使用するフィルタ文字列。
                                      'これを開くには、MSA_CreateFilterString() を使用します。
        lngFilterIndex As Long        ' 表示するフィルタの初期値。既定値は 1。
        strInitialDir As String       ' ダイアログに表示される初期ディレクトリ名。既定値は、カレント ディレクトリ。
        strInitialFile As String      ' ダイアログに表示される初期ファイル名。既定値は、""。
        strDialogTitle As String
        strDefaultExtension As String ' 拡張子が指定されなかった場合にファイルに追加する既定の拡張子。既定値は、システム値です。
        lngFlags As Long              ' フラグ。既定値は、フラグなし。
        strFullPathReturned As String ' 選択されたファイルのフル パス。
                                      'ダイアログでユーザーが拡張子のないファイルを選択すると、[ファイル名] ボックスのテキストだけが返されます。
        strFileNameReturned As String ' 選択されたファイルの名前。
        intFileOffset As Integer      ' フルパス (strFullPathReturned) のファイル名の開始を示すオフセット。
        intFileExtension As Integer   ' フルパス (strFullPathReturned) のファイルの拡張子の開始を示すオフセット。
    End Type

Public Function saFindFile(Title, strSearchPath, FileNm, FileExt) As String
' Window Tilte / Default Path / Comm / extension
' ex: saFindFile("TTL","C:\a.log","Log File","*.log")
    
    Dim msaof As MSA_OPENFILENAME
    
    msaof.strDialogTitle = Title
    msaof.strInitialDir = strSearchPath
    msaof.strFilter = MSA_CreateFilterString(FileNm, FileExt, "All files(*.*)", "*.*")
    
    MSA_GetOpenFileName msaof
    
    saFindFile = Trim(msaof.strFullPathReturned)
    DoEvents
End Function

Private Function MSA_CreateFilterString(ParamArray varFilt() As Variant) As String
' 渡された引数からフィルタ文字列を作成します。
' 引数として何も渡されなかった場合は、長さ 0 の文字列 ("") を返します。
' 引数が遇数個渡された場合、それに *.* を追加します。
    
    Dim strFilter As String
    Dim intRet As Integer
    Dim intNum As Integer

    intNum = Ubound(varFilt)
    If (intNum <> -1) Then
        For intRet = 0 To intNum
            strFilter = strFilter & varFilt(intRet) & vbNullChar
        Next
        If intNum Mod 2 = 0 Then
            strFilter = strFilter & "*.*" & vbNullChar
        End If
        
        strFilter = strFilter & vbNullChar
    Else
        strFilter = ""
    End If

    MSA_CreateFilterString = strFilter
End Function

Private Function MSA_GetOpenFileName(msaof As MSA_OPENFILENAME) As Integer
    
    Dim of As OPENFILENAME
    Dim intRet As Integer
    Const OFN_HIDEREADONLY = &H4

    MSAOF_to_OF msaof, of
    of.Flags = of.Flags Or OFN_HIDEREADONLY
    
    intRet = GetOpenFileName(of)
    If intRet Then
        OF_to_MSAOF of, msaof
    End If
    
    MSA_GetOpenFileName = intRet
End Function

Private Sub MSAOF_to_OF(msaof As MSA_OPENFILENAME, of As OPENFILENAME)
' このプロシージャは、MSAccess 構造体を win32 構造体に変換します。
    
    Dim strFile As String * 512
    Const ALLFILES = "All files"


    ' 構造体の一部を初期化します。
    'Of.hwndOwner = Application.hWndAccessApp
    of.hInstance = 0
    'of.lpstrCustomFilter = 0 '------ VBA7 x64 ではコメントアウトにする必要あり
    of.nMaxCustrFilter = 0
    of.lpfnHook = 0
    of.lpTemplateName = 0
    of.lCustrData = 0
    If msaof.strFilter = "" Then
        of.lpstrFilter = MSA_CreateFilterString(ALLFILES)
      Else
        of.lpstrFilter = msaof.strFilter
    End If
    of.nFilterIndex = msaof.lngFilterIndex
    'of.lpstrFile = msaof.strInitialFile & String(512 - LenB(msaof.strInitialFile), 0)
    of.nMaxFile = 511
    of.lpstrFileTitle = String(512, 0)
    of.nMaxFileTitle = 511
    of.lpstrTitle = msaof.strDialogTitle
    of.lpstrInitialDir = msaof.strInitialDir
    of.lpstrDefExt = msaof.strDefaultExtension
    of.Flags = msaof.lngFlags
        of.lpstrFile = msaof.strInitialFile & String(512 - LenB(msaof.strInitialFile), 0)
        of.lStructSize = LenB(of)
End Sub

Private Sub OF_to_MSAOF(of As OPENFILENAME, msaof As MSA_OPENFILENAME)
' このプロシージャは、win32 構造体を MSAccess 構造体に変換します。
    
    Msaof.strFullPathReturned = Left(of.lpstrFile, InStr(of.lpstrFile, vbNullChar) - 1)
    msaof.strFileNameReturned = of.lpstrFileTitle
    msaof.intFileOffset = of.nFileOffset
    msaof.intFileExtension = of.nFileExtension
End Sub


上記コードをModuleに貼り付けます

【引数】
 ダイアログのタイトル、デフォルトのパス、ファイルの種類名、拡張子

【サンプル】
wk = saFindFile("ダイアログのタイトル", "e:\", "テキストファイル(*.txt)", "*.txt")
If wk <> "" Then Me!Text1 = wk

【特記事項】
キャンセルボタンをクリックしたときには、文字長さゼロの文字が返ります

  お気軽にご相談ください お問合せ・ご相談はこちら お問合せ・ご相談はこちら  
更新日:2017/02/21 14:23