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