'
' Access 97 / Windows 用「ファイルを開くダイアログ」モジュール  version 1.10
'
' - version 1.00 (1997.12.29)
' - version 1.02 (1999.10.10) SaveFileDialogを追加
' - version 1.10 (2000.12.03) lpstrFileTitleをLongに修正（異常終了バグを修正）
'
' Copyright (C) Evio, 1997-2000

'==============================================================================================================
' 名前:
'   OpenFileDialog 関数
'
' 書式:
'   ファイル名 = OpenFileDialog(タイトル, 開始時のフォルダ, 既定のファイル名, フィルタ, 標準拡張子)
'
' 概要:
'   Windows の「ファイルを開く」ダイアログを表示します。
'
' 引数:
'   タイトル ------------ ダイアログボックスの標題
'   開始時のフォルダ ----- 最初にファイル一覧が表示されるフォルダ（末尾の \ は任意）
'   既定のファイル名 ----- ダイアログボックスに最初から入力されているファイル名（パス指定は任意）
'   フィルタ ------------ 「ファイルの種類」の一覧（末尾の | は任意）
'   標準拡張子 ---------- 拡張子なしでファイル名を入力したときに自動的に付加される拡張子（先頭の . は任意）
'
' 戻り値:
'   「開く」が指定されると、ファイルの絶対パスが戻ります。
'   「キャンセル」が指定されると、「既定のファイル名」が戻ります。
'
' 使用例:
'    filename = OpenFileDialog("入力元ファイルの指定", "c:\my documents", "", _
'        "Microsoft Excel ﾜｰｸｼｰﾄ (*.xls)|*.xls|すべてのファイル (*.*)|*.*", ".xls")
'    If filename <> "" Then MsgBox filename
'==============================================================================================================

'==============================================================================================================
' 名前: SaveFileDialog 関数
' 書式: OpenFileDialog 関数と同じ。
' 概要: Windows の「名前を付けて保存」ダイアログを表示します。
' 引数: OpenFileDialog 関数と同じ。
' 戻り値:
'   「保存」が指定されると、ファイルの絶対パスが戻ります。
'   「キャンセル」が指定されると、空文字列 "" が戻ります。
'
' 使用例:
'    filename = SaveFileDialog("出力先ファイルの指定", "c:\my documents", "default.xls", _
'        "Microsoft Excel ﾜｰｸｼｰﾄ (*.xls)|*.xls|すべてのファイル (*.*)|*.*", ".xls")
'    If filename <> "" Then MsgBox filename
'==============================================================================================================

Option Compare Database
Option Explicit

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
Const OFN_NOTESTFILECREATE = &H10000
Const OFN_NONETWORKBUTTON = &H20000
Const OFN_NOLONGNAMES = &H40000
Const OFN_EXPLORER = &H80000
Const OFN_NODEREFERENCELINKS = &H100000
Const OFN_LONGNAMES = &H200000

Type OPENFILENAME型
    lStructSize         As Long     'DWORD
    hwndOwner           As Long     'HWND
    hInstance           As Long     'HINSTANCE
    lpstrFilter         As String   'LPCTSTR
    lpstrCustomFilter   As Long     'LPTSTR
    nMaxCustFilter      As Long     'DWORD
    nFilterIndex        As Long     'DWORD
    lpstrFile           As String   'LPTSTR
    nMaxFile            As Long     'DWORD
    lpstrFileTitle      As Long     'LPTSTR
    nMaxFileTitle       As Long     'DWORD
    lpstrInitialDir     As String   'LPCTSTR
    lpstrTitle          As String   'LPCTSTR
    Flags               As Long     'DWORD
    nFileOffset         As Integer  'WORD
    nFileExtension      As Integer  'WORD
    lpstrDefExt         As String   'LPCTSTR
    lCustData           As Long     'DWORD
    lpfnHook            As Long     'LPOFNHOOKPROC
    lpTemplateName      As Long     'LPCTSTR
End Type

Declare Function GetOpenFileName Lib "comdlg32" Alias "GetOpenFileNameA" (ByRef ofn As OPENFILENAME型) As Long
Declare Function GetSaveFileName Lib "comdlg32" Alias "GetSaveFileNameA" (ByRef ofn As OPENFILENAME型) As Long

Public Function OpenFileDialog(タイトル As String, パス名 As String, 既定値 As String, _
    フィルタ As String, 標準拡張子 As String) As String
On Error Resume Next
    Dim ofn As OPENFILENAME型
    InitOFN ofn, タイトル, パス名, 既定値, フィルタ, 標準拡張子
    ofn.Flags = OFN_PATHMUSTEXIST + OFN_FILEMUSTEXIST + OFN_HIDEREADONLY
    If GetOpenFileName(ofn) = 0 Then
        OpenFileDialog = 既定値
    Else
        OpenFileDialog = left(ofn.lpstrFile, InStr(ofn.lpstrFile, Chr(0)) - 1)
    End If
End Function

Public Function SaveFileDialog(タイトル As String, パス名 As String, 既定値 As String, _
    フィルタ As String, 標準拡張子 As String) As String
On Error Resume Next
    Dim ofn As OPENFILENAME型
    InitOFN ofn, タイトル, パス名, 既定値, フィルタ, 標準拡張子
    ofn.Flags = OFN_PATHMUSTEXIST + OFN_OVERWRITEPROMPT + OFN_HIDEREADONLY
    If GetSaveFileName(ofn) = 0 Then
        SaveFileDialog = ""
    Else
        SaveFileDialog = left(ofn.lpstrFile, InStr(ofn.lpstrFile, Chr(0)) - 1)
    End If
End Function

Private Sub InitOFN(ByRef ofn As OPENFILENAME型, タイトル As String, パス名 As String, 既定値 As String, _
        ByVal フィルタ As String, ByVal 標準拡張子 As String)
On Error Resume Next
    フィルタ = フィルタ化変換(フィルタ)
    If left(標準拡張子, 1) = "." Then 標準拡張子 = Mid(標準拡張子, 2)
    ofn.lStructSize = 76
    ofn.hwndOwner = Screen.ActiveForm.hWnd
    ofn.hInstance = 0
    ofn.lpstrFilter = フィルタ
    ofn.lpstrCustomFilter = 0
    ofn.nMaxCustFilter = 0
    ofn.nFilterIndex = 0
    ofn.lpstrFile = 既定値 & String(260 - Len(既定値), 0)
    ofn.nMaxFile = 260
    ofn.lpstrFileTitle = 0
    ofn.nMaxFileTitle = 0
    ofn.lpstrInitialDir = パス名
    ofn.lpstrTitle = タイトル
    'ofn.Flags = OFN_PATHMUSTEXIST + OFN_FILEMUSTEXIST + OFN_HIDEREADONLY
    ofn.nFileOffset = 0
    ofn.nFileExtension = 0
    ofn.lpstrDefExt = 標準拡張子
    ofn.lCustData = 0
    ofn.lpfnHook = 0
    ofn.lpTemplateName = 0
End Sub

Public Function フィルタ化変換(ByRef フィルタ文字列 As String) As String
    Dim 位置 As Integer
    Dim フィルタ As String
    フィルタ = フィルタ文字列 & "|"
    位置 = InStr(フィルタ, "|")
    While 位置 > 0
        Mid(フィルタ, 位置, 1) = Chr(0)
        位置 = InStr(位置, フィルタ, "|")
    Wend
    フィルタ化変換 = フィルタ
End Function

'=== end of module ===