Accessで「ファイルを保存」ダイアログを使用 - えんどーさんメモ

Accessで「ファイルを保存」ダイアログを使用

Accessバージョン：2003

WindowsAPIのGetSaveFileNameを使用する。

【例】

Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenFileName As OPENFILENAME) As Long

Type OPENFILENAME
　lStructSize As Long
　hwndOwner As Long
　hInstance As Long
　lpstrFilter As String
　lpstrCustomFilter As Long
　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 Long
　lpTemplateName As Long
End Type

Const OFN_ALLOWMULTISELECT = &H200
Const OFN_CREATEPROMPT = &H2000
Const OFN_EXPLORER = &H80000
Const OFN_FILEMUSTEXIST = &H1000
Const OFN_HIDEREADONLY = &H4
Const OFN_NOCHANGEDIR = &H8
Const OFN_NODEREFERENCELINKS = &H100000
Const OFN_NONETWORKBUTTON = &H20000
Const OFN_NOREADONLYRETURN = &H8000
Const OFN_NOVALIDATE = &H100
Const OFN_OVERWRITEPROMPT = &H2
Const OFN_PATHMUSTEXIST = &H800
Const OFN_READONLY = &H1
Const OFN_SHOWHELP = &H10
Const OFN_EXTENSIONDIFFERENT = &H400
Function PutFileName() As String
　Dim pOpenFileName As OPENFILENAME
　Dim lngRet As Long

　pOpenFileName.hwndOwner = Application.hWndAccessApp
　pOpenFileName.hInstance = 0
　pOpenFileName.lpstrFilter = "MDBファイル (*.mdb)" & String(1, vbNullChar) & "*.mdb" & String(2, vbNullChar)　←ここではAccess MDBファイルを指定している
　pOpenFileName.lpstrCustomFilter = 0
　pOpenFileName.nMaxCustrFilter = 0
　pOpenFileName.nFilterIndex = 1
　pOpenFileName.lpstrFile = String(511, vbNullChar)
　pOpenFileName.nMaxFile = 511
　pOpenFileName.lpstrFileTitle = String(512, vbNullChar)
　pOpenFileName.nMaxFileTitle = 511
　pOpenFileName.lpstrInitialDir = String(1, vbNullChar)
　pOpenFileName.lpstrTitle = String(1, vbNullChar)
　pOpenFileName.nFileOffset = 0
　pOpenFileName.nFileExtension = 0
　pOpenFileName.lpstrDefExt = String(1, vbNullChar)
　pOpenFileName.lCustrData = 0
　pOpenFileName.lpfnHook = 0
　pOpenFileName.lpTemplateName = 0
　pOpenFileName.lStructSize = Len(pOpenFileName)
　pOpenFileName.Flags = OFN_HIDEREADONLY Or OFN_EXPLORER

　ngRet = GetSaveFileName(pOpenFileName)

　PutFileName = Left(pOpenFileName.lpstrFile, _
　InStr(pOpenFileName.lpstrFile, vbNullChar) - 1)

End Function

【使用例】

Sub test
　Dim filename as string

　 filename = PutFileName
　　　・
　　　・
End Sub