ファイル選択ダイアログボックスを表示
　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　玄関へお回り下さい。 　　
ファイル選択（保存）ダイアログボックスを表示                (112)
　　 Option Explicit　　　'SampleNo=112　WindowsXP VB6.0(SP5) 2002.05.22
'ファイル選択ダイアログボックスを表示する(P157)
Private Declare Function GetOpenFileName Lib "comdlg32.dll" _
　　Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
'ファイル保存ダイアログボックスを表示する(P160)
Private Declare Function GetSaveFileName Lib "comdlg32.dll" _
　　Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long

'動作条件を設定するOPENFILENAME構造体（P158)
Private Type OPENFILENAME
　　lStructSize　　　 As Long　　'構造体のサイズ
　　hwndOwner　　　　 As Long　　'親ウィンドウのハンドル
　　hInstance　　　　 As Long　　'モジュールのインスタンスハンドル
　　lpstrFilter　　　 As String　'VBのファイルパターン
　　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　　'動作を指定する定数の組合せ
　　nFileOffset　　　 As Integer 'フルパス中のファイル名までのオフセット
　　nFileExtension　　As Integer '同　拡張子までのオフセット
　　lpstrDefExt　　　 As String　'デフォルトの拡張子
　　lCustData　　　　 As Long　　'フックプロシージャに渡すデータ
　　lpfnHook　　　　　As Long　　'フックプロシージャOFNHookprocへのポインター
　　lpTemplateName　　As String　'テンプレートリソース名
End Type
Private Const OFN_HIDEREADONLY = &H4
Private Const OFN_OVERWRITEPROMPT = &H2
Private Const OFN_FILEMUSTEXIST = &H1000
Private Const OFN_PATHMUSTEXIST = &H800
Private Const OFN_EXPLORER = &H80000
Private strFileName　 As String


Private Sub mnuFileExit_Click()
　　Unload Me
End Sub


Private Sub mnuFileOpen_Click()
'メニューの開く
　　Dim tOpenFileName As OPENFILENAME
　　With tOpenFileName
　　　　'構造体のサイズを設定
　　　　.lStructSize = Len(tOpenFileName)
　　　　'親ウィンドウのハンドルを指定
　　　　.hwndOwner = Me.hWnd
　　　　'アプリケーションのインスタンスのハンドルを指定
　　　　.hInstance = App.hInstance '不要の時　0&
　　　　'ファイルパターンを設定（複数指定する場合は続いて記入）
　　　　.lpstrFilter = "テキストファイル(*.txt)" & vbNullChar & "*.txt" _
　　　　& vbNullChar & "すべてのファイル(*.*)" & vbNullChar & "*.*"

　　　　'優先的に表示させるフィルターのインデックス
　　　　.nFilterIndex = 1
　　　　'ファイル名の内容を初期化
　　　　.lpstrFile = String$(256, Chr$(0)) ' "*.txt" & String$(256, Chr$(0))
　　　　'同バイト数
　　　　.nMaxFile = 256
　　　　'ファイル名を受取るバッファーの設定(Nullで埋めておく）
　　　　.lpstrFileTitle = String$(256, Chr$(0))
　　　　'同バイト数
　　　　.nMaxFileTitle = 256
　　　　'デフォルトのフォルダー名の設定
　　　　.lpstrInitialDir = "C:\"
　　　　'ダイアログのキャプション名
　　　　.lpstrTitle = "ファイルを開く"
　　　　'flagsの動作の設定
　　　　.flags = OFN_EXPLORER Or OFN_PATHMUSTEXIST _
　　　　　　Or OFN_FILEMUSTEXIST Or OFN_HIDEREADONLY
　　End With
　　'ダイアログの表示
　　If GetOpenFileName(tOpenFileName) = 0 Then
　　　　'キャンセルボタンを押した場合（クローズ・エラーも）
　　　　strFileName = ""
　　　　Exit Sub
　　Else
　　　　'開くボタンを押した場合（ファイル名を取得）
　　　　strFileName = Left$(tOpenFileName.lpstrFile, _
　　　　　　　　InStr(tOpenFileName.lpstrFile, vbNullChar) - 1)
　　End If
　　'一応拡張子を照合してからOpen
　　If StrComp(Right$(strFileName, 4), ".txt", 1) = 0 Then
　　　　'テキストファイルをバイナリデータとして読込表示する
　　　　Dim intFileNo As Integer
　　　　'使用可能なファイル番号を取得する
　　　　intFileNo = FreeFile
　　　　'ファイルをシーケンシャル入力モードで開く
　　　　Open strFileName For Input As #intFileNo
　　　　'バイナリデータとして読込んでUnicodeに変換して表示
　　　　Text1.Text = StrConv(InputB$(LOF(intFileNo), intFileNo), vbUnicode)
　　　　Close #intFileNo
　　Else
　　　　MsgBox "正しいファイル名を指定して下さい。"
　　End If
End Sub


Private Sub mnuFileSave_Click()
'メニューの名前を付けて保存
　　Dim tOpenFileName As OPENFILENAME
　　Dim lngRet　　　　As Long
　　With tOpenFileName
　　　　'構造体のサイズを設定
　　　　.lStructSize = Len(tOpenFileName)
　　　　'親ウィンドウのハンドルを指定
　　　　.hwndOwner = Me.hWnd
　　　　'アプリケーションのインスタンスのハンドルを指定
　　　　.hInstance = App.hInstance '不要の時　0&
　　　　'ファイルパターンを設定（複数指定する場合は続いて記入）
　　　　.lpstrFilter = "テキストファイル(*.txt)" & vbNullChar & "*.txt" _
　　　　& vbNullChar & "すべてのファイル(*.*)" & vbNullChar & "*.*"

　　　　'優先的に表示させるフィルターのインデックス
　　　　.nFilterIndex = 1
　　　　'ファイル名の内容を初期化
　　　　.lpstrFile = strFileName & String$(256, Chr$(0))
　　　　'同バイト数
　　　　.nMaxFile = 256
　　　　'ファイル名を受取るバッファーの設定(Nullで埋めておく）
　　　　.lpstrFileTitle = String$(256, Chr$(0))
　　　　'同バイト数
　　　　.nMaxFileTitle = 256
　　　　'デフォルトのフォルダー名の設定
　　　　.lpstrInitialDir = "C:\"
　　　　'ダイアログのキャプション名
　　　　.lpstrTitle = "名前を付けて保存"
　　　　'flagsの動作の設定
　　　　.flags = OFN_PATHMUSTEXIST Or OFN_FILEMUSTEXIST Or _
　　　　 OFN_HIDEREADONLY Or OFN_OVERWRITEPROMPT

　　End With
　　lngRet = GetSaveFileName(tOpenFileName)
　　If lngRet = 0 Then
　　'キャンセルボタンを押した場合（クローズ・エラーも）
　　　　strFileName = ""
　　　　Exit Sub
　　Else
　　'保存ボタンを押した場合（ファイル名を取得）
　　　　strFileName = Left$(tOpenFileName.lpstrFile, _
　　　　　　　　InStr(tOpenFileName.lpstrFile, vbNullChar) - 1)
　　End If
　　'一応拡張子を照合してからSAVE
　　If StrComp(Right$(strFileName, 4), ".txt", 1) = 0 Then
　　　　'テキストファイルをバイナリモードで書込み
　　　　Dim intFileNo As Integer
　　　　intFileNo = FreeFile
　　　　'ファイルをバイナリモードで開く
　　　　Open strFileName For Binary Access Write As #intFileNo
　　　　　　'テキストファイルを丸ごと書込み
　　　　　　Put #intFileNo, , Text1.Text
　　　　Close #intFileNo
　　Else
　　　　MsgBox "正しいファイル名を指定して下さい。"
　　End If
End Sub
自分で使うだけなら、CommonDialog コントロールを使えば簡単ですが、プログラムを配布したり
すると、添付しなければならないし、ファイルサイズが大きくなったり、その他問題も発生します。
そこで、ちょっと面倒ですがAPIを使って実現しました。ご使用される場合は、ご自分の環境に
合わせて変更してお使いください。
　　　　




2002/05/22