「名前を付けてファイルを保存」コモンダイアログを呼び
|
 |
| タイトル | 「名前を付けてファイルを保存」コモンダイアログを呼び出す |
| 対象言語 | VB4.0, Access95以降 |
| 動作確認ＯＳ | Windows95,98,NT4.0 |
| 使用関数 | ShellExecute |
| 改築日 | 1998/05/17 |
| Source Download | |
「名前を付けてファイルを保存」コモンダイアログを呼び
|
|
| 1. フォームを作成し、コマンドボタン（Command1）、テキストボックス(Text1)を貼り付けてください。 Option Explicit Private Sub Command1_Click() Dim tag As OpenFileName2 Dim text As TextBox 'ダイアログのパラメータ設定 With tag .DefaultExt = "txt" .DialogTitle = "ファイルを選択して下さい。" .FileName = vbNullString .FilePath = vbNullString .FileTitle = vbNullString .Filter = "テキスト(*.txt)|*.txt|データベース(*.mdb)|*.mdb|全てのファイル(*.*)|*.*" .FilterIndex = 1 .flags = OFN_HIDEREADONLY .InitDir = "c:\" .MaxFileSize = MAX_PATH End With 'ダイアログ呼び出し If Y_GetOpenFileDialog(Me.hWnd, tag) Then Set text = Me!Text1 text = "選択したフルパス名 = " & tag.FileName & vbCrLf text = text & "選択したフォルダ名 = " & tag.FilePath & vbCrLf text = text & "選択したファイル名 = " & tag.FileTitle Else Call MsgBox("選択をキャンセルされました。(ToT)") End If End Sub |
| 3.モジュールウインドウを作成し、下のソースを入力してください。 Option Explicit '「名前を付けてファイルに保存」コモンダイアログを呼び出す 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 String 'ユーザー定義のフィルタ文字列のペア nMaxCustrFilter As Long 'lpstrCustomFilterのバッファサイズ nFilterIndex As Long 'フィルタコンボボックスの初期インデックス値 lpstrFile As String '選択されたファイル名のフルパス nMaxFile As Long 'lpstrFileのバッファサイズ lpstrFileTitle As String '選択されたファイル名のタイトル nMaxFileTitle As Long 'lpstrFileTitleのバッファサイズ ｌpstrInitialDir 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 'Flagsに設定する値 Public Const OFN_ALLOWMULTISELECT = &H200 'ファイル名リストボックスで複数選択を可能にする Public Const OFN_CREATEPROMPT = &H2000 '現在存在しないファイルを作成するかを確認する Public Const OFN_EXTENSIONDIFFERENT = &H400 'ファイル名の拡張子とlpstrDefExtで指定された拡張子が異なる Public Const OFN_FILEMUSTEXIST = &H1000 '既存のファイルだけ入力できるようにする Public Const OFN_HIDEREADONLY = &H4 '[読み取り専用]チェックボックスを表示しない Public Const OFN_NOCHANGEDIR = &H8 'ダイアログボックスを開いたときに現在のディレクトリを表示する Public Const OFN_NOREADONLYRETURN = &H8000 '読み取り専用属性を持たず、読み取り専用フォルダにないファイルを取得する Public Const OFN_NOVALIDATE = &H100 '無効な文字を含むファイル名を指定出来るようにする Public Const OFN_OVERWRITEPROMPT = &H2 '[ファイル名を付けて保存]ダイアログで選択したファイルが存在する場合の上書確認する Public Const OFN_PATHMUSTEXIST = &H800 '無効なパスを入力したときに警告メッセージを表示する Public Const OFN_READONLY = &H1 '[読み取り専用]チェックボックスをオンにする Public Const OFN_SHAREAWARE = &H4000 '共有違反エラーを無視する Public Const OFN_SHOWHELP = &H10 'ダイアログ ボックスに [ヘルプ] ボタンを表示する Public Const OFN_EXPLORER = &H80000 'エクスプローラに似たダイアログボックスにする Public Const OFN_NODEREFERENCELINKS = &H100000 'ショートカットを実行しない Public Const OFN_LONGNAMES = &H200000 '長いファイル名を使用する Type OpenFileName2 DefaultExt As String '拡張子を付けなかった時のデフォルト拡張子 DialogTitle As String 'タイトルバーに表示するタイトル名 FileName As String 'ダイアログを閉じた後、選択したファイルのフルパスが入る FilePath As String '選択したファイルが含まれるパスの名前 FileTitle As String '選択したファイルのパスを含まない名前 Filter As String 'フィルター FilterIndex As Long '複数フィルターを設定している時の表示するフィルターのインデックス番号 flags As Long 'ダイアログボックスの作成フラグ InitDir As String '初期フォルダ名 MaxFileSize As Long 'ファイル名の最大サイズを設定 (1〜 32768 既定値256) OKFlg As Integer '1:ファイルを選択した 0:選択をキャンセルした End Type Public Const MAX_PATH = 260 Public Function Y_GetSaveFileDialog(hWnd As Long, OpenInfo As OpenFileName2) As Boolean '*********************************************************** '機能 : 「ファイル名を付けて保存」コモンダイアログを呼び出す '引数 : Fm = 呼び出し元のフォームオブジェクト ' OpenInfo = 「ファイル名を付けて保存」ダイアログの ' 初期設定値 '戻り値: ダイアログを閉じた後の設定値 '*********************************************************** Dim getfile As OPENFILENAME Dim FilterBuf As String Dim StrBuf As String Dim i As Long Dim j As Long Dim cnt As Integer Dim filindex As Integer Dim longret As Long '初期値設定 If Left$(OpenInfo.DefaultExt, 1) = "." Then OpenInfo.DefaultExt = Mid$(OpenInfo.DefaultExt, 2) End If If OpenInfo.DialogTitle = vbNullString Then OpenInfo.DialogTitle = "ファイルを開く" End If If OpenInfo.MaxFileSize < 1 Or OpenInfo.MaxFileSize > 32768 Then OpenInfo.MaxFileSize = MAX_PATH End If If OpenInfo.FileTitle = vbNullString Then OpenInfo.FileTitle = String$(OpenInfo.MaxFileSize, 0) End If FilterBuf = OpenInfo.Filter j = 1 cnt = 1 Do While True i = InStr(j, FilterBuf, "|") If i = 0 Then Exit Do End If Mid$(FilterBuf, i, 1) = vbNullChar j = i + 1 cnt = cnt + 1 Loop If OpenInfo.FilterIndex < 1 Or OpenInfo.FilterIndex > cnt Then filindex = 0 Else filindex = OpenInfo.FilterIndex End If StrBuf = String(OpenInfo.MaxFileSize, 0) 'コモンダイアログを呼び出す With getfile .lStructSize = Len(getfile) .hwndOwner = hWnd .hInstance = 0 'App.hInstance .lpstrFilter = FilterBuf .nMaxCustrFilter = 0& .nFilterIndex = filindex .lpstrFile = StrBuf .nMaxFile = OpenInfo.MaxFileSize .lpstrFileTitle = OpenInfo.FileTitle .nMaxFileTitle = Len(OpenInfo.FileTitle) + 1 .lpstrInitialDir = OpenInfo.InitDir .lpstrTitle = OpenInfo.DialogTitle .flags = OpenInfo.flags .lpstrDefExt = OpenInfo.DefaultExt End With Y_GetSaveFileDialog = (GetSaveFileName(getfile) <> 0) '戻り値セット With OpenInfo .FileName = EditBuf(getfile.lpstrFile) .FilePath = StrConv(LeftB$(StrConv(getfile.lpstrFile, vbFromUnicode), getfile.nFileOffset), vbUnicode) .FileTitle = EditBuf(getfile.lpstrFileTitle) End With End Function Public Function EditBuf(Buf As String) As String '*********************************************************** '機能 : 引数 Bufの文字列中の Nullコードを検索し、Nullコードを ' 除いた文字列を返す '引数 : Buf = Nullコードを含む文字列 '戻り値: Nullコードを除いた文字列 '*********************************************************** Dim i As Long i = InStr(Buf, vbNullChar) If i <> 0 Then EditBuf = Left$(Buf, i - 1) Else EditBuf = Buf End If End Function |
| Copyright (C)1997-2001 空耳工房 MY2Project All rights reserved. |