| タイトル | ： Re^3: ACCESS VBAでダイアログを開く |
| 記事No | ： 599 |
| 投稿日 | ： 2003/12/16(Tue) 10:10 |
| 投稿者 | ： 田村 |
[OSのVer]：Windows2000 [VBのVer]：ACCESS VBA
すみません。解決しました。
Option Compare Database
Type OPENFILENAME
lStructSize As Long '構造体のサイズ
hWndOwner As Long '０を指定すると表示位置は左上となる
hInstance As Long 'インスイタンス
lpstrFilter As String 'フィルター
lpstrCustomFilter As String 'カスタムフィルター
nMaxCustFilter 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 'OFN_XXX、フラグ
nFileOffset As Integer 'フルパスのファイル名までのオフセット
nFileExtension As Integer '拡張子までのオフセット
lpstrDefExt As String 'デフォルトの拡張子
lCustData As Long '???
lpfnHook As Long 'フック関数へのポインタ
lpTemplateName As String 'ダイアログのタイトル名
End Type
Const OFN_READONLY = &H1 '[読み取り専用] のチェック ボックスをオンにした状態で表示する
Const OFN_OVERWRITEPROMPT = &H2 '既存のファイル名がある場合メッセージボックスを表示
Const OFN_HIDEREADONLY = &H4 '[読み取り専用] チェック ボックスを非表示にする
Const OFN_NOCHANGEDIR = &H8 '他のサブディレクトリから選択不可能
Const OFN_SHOWHELP = &H10 'ヘルプボタンを表示する
Const OFN_ENABLEHOOK = &H20
Const OFN_ENABLETEMPLATE = &H40
Const OFN_ENABLETEMPLATEHANDLE = &H80
Const OFN_NOVALIDATE = &H100 'ファイル名の有効性をチェックしない
Const OFN_ALLOWMULTISELECT = &H200 '複数ファイルを選択可能にする
Const OFN_EXTENSIONDIFFERENT = &H400
Const OFN_PATHMUSTEXIST = &H800 '有効なパス名だけだけを受け取る
Const OFN_FILEMUSTEXIST = &H1000 '指定したファイル名は必ず存在しなければならない
Const OFN_CREATEPROMPT = &H2000 'ファイル名の指定がないときメッセージボックスを表示
Const OFN_SHAREAWARE = &H4000 '共有違反のエラーを無視する
Const OFN_NOREADONLYRETURN = &H8000 'Read Onlyファイルと上書き禁止ファイルディレクトリからの選択
不可能
Const OFN_NOTESTFILECREATE = &H10000
Const OFN_NONETWORKBUTTON = &H20000
Const OFN_NOLONGNAMES = &H40000 '長いファイル名を使用しない
Const OFN_EXPLORER = &H80000 'Windows 95の［ファイルを開く］ダイアログボックスのテンプレート
Const OFN_NODEREFERENCELINKS = &H100000 'ショートカットを使用しない
Const OFN_LONGNAMES = &H200000 '長いファイル名を使用する
Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename
As OPENFILENAME) As Long
'---------------------------------------------------------------------------
' 関数名： GetSaveFilePath
' 機能 ： ファイルを保存するためのダイアログボックスを表示し、ファイル名、または
' ファイルのフルパスを返す
' 引数 ： (in) RetMode … 0 -> ファイルのフルパスを返す
' 1 -> ファイル名を返す
' (in) Filter … 拡張子設定のフィルタ (省略可能)
' (in) InitialDir … ディレクトリ指定 (省略可能)
' (in) DialogTitle … ダイアログボックスのタイトル (省略可能)
' 返り値 ： ファイル名、またはファイルのフルパス キャンセル：空文字
'---------------------------------------------------------------------------
Function GetSaveFilePath(ByVal RetMode As Integer, _
Optional ByVal Filter As String = "CSVファイル (*.csv)" & vbNullChar
& "*.csv" & vbNullChar, _
Optional ByVal InitialDir As String = "C:\", _
Optional ByVal DialogTitle As String = "ファイルを名前を付けて保存す
る") As String
Dim udtOpenFile As OPENFILENAME
Dim ret As Long
With udtOpenFile
.lStructSize = Len(udtOpenFile) '構造体のサイズ
.hWndOwner = 0 'オーナーハンドルを指定
.hInstance = 0 'インスタンス指定
.flags = OFN_PATHMUSTEXIST Or OFN_HIDEREADONLY Or _
OFN_OVERWRITEPROMPT 'フラグを指定する
.lpstrFile = String(255, Chr$(0)) 'ファイル名を格納するバッファを設定
.nMaxFile = 255 'ファイル名を格納するバッファサイズ
.lpstrFileTitle = String(255, Chr$(0)) 'ファイルのフルパスを格納するバッファ
.nMaxFileTitle = 255 ' ファイルのフルパスを格納するバッファサイズ
.lpstrInitialDir = InitialDir '初期ディレクトリ指定
.lpstrFilter = Filter 'フィルターの設定
.nFilterIndex = 1 'フィルターインデックスを指定
.lpstrTitle = DialogTitle 'ダイアログボックスの名前を指定
End With
ret = GetSaveFileName(udtOpenFile)
If ret <> 0 Then
Select Case RetMode
Case 0 'ファイルのフルパスを返す
GetSaveFilePath = Left$(udtOpenFile.lpstrFile, InStr(udtOpenFile.lpstrFile,
Chr$(0)) - 1)
Case Else 'ファイル名を返す
GetSaveFilePath = Left$(udtOpenFile.lpstrFileTitle, InStr
(udtOpenFile.lpstrFileTitle, Chr$(0)) - 1)
End Select
Else
GetSaveFilePath = ""
End If
End Function
こんな感じだそうです。
|