' ******************************************************
' OPENFILENAME 構造体
' ******************************************************
Type OPENFILENAME
        lStructSize As Long         ' 76
        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
        nFileOffset As Integer
        nFileExtension As Integer
        lpstrDefExt As String
        lCustData As Long
        lpfnHook As Long
        lpTemplateName As String
End Type

' ******************************************************
' 開く
' ******************************************************
Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" ( _
    pOpenfilename As OPENFILENAME _
) As Long

' ******************************************************
' 保存する
' ******************************************************
Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" ( _
    pOpenfilename As OPENFILENAME _
) As Long

Global Const OFN_READONLY = &H1
Global Const OFN_OVERWRITEPROMPT = &H2
Global Const OFN_HIDEREADONLY = &H4
Global Const OFN_NOCHANGEDIR = &H8
Global Const OFN_SHOWHELP = &H10
Global Const OFN_ENABLEHOOK = &H20
Global Const OFN_ENABLETEMPLATE = &H40
Global Const OFN_ENABLETEMPLATEHANDLE = &H80
Global Const OFN_NOVALIDATE = &H100
Global Const OFN_ALLOWMULTISELECT = &H200
Global Const OFN_EXTENSIONDIFFERENT = &H400
Global Const OFN_PATHMUSTEXIST = &H800
Global Const OFN_FILEMUSTEXIST = &H1000
Global Const OFN_CREATEPROMPT = &H2000
Global Const OFN_SHAREAWARE = &H4000
Global Const OFN_NOREADONLYRETURN = &H8000
Global Const OFN_NOTESTFILECREATE = &H10000
Global Const OFN_NONETWORKBUTTON = &H20000
Global Const OFN_NOLONGNAMES = &H40000
Global Const OFN_EXPLORER = &H80000
Global Const OFN_NODEREFERENCELINKS = &H100000
Global Const OFN_LONGNAMES = &H200000

' -----------------------------------------
' フォルダの参照ダイアログ
' -----------------------------------------
Type BROWSEINFO
      hwndOwner As Long
      pidlRoot As Long
      pszDisplayName As String
      lpszTitle As String
      ulFlags As Long
      lpfn As Long
      lParam As Long
      iImage As Long
End Type
Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" ( _
    lpBROWSEINFO As BROWSEINFO _
) As Long
Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" ( _
    ByVal pidl As Long, _
    ByVal pszPath As String _
) As Long
Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long)

' ******************************************************
' フォルダの選択ダイアログ
' ******************************************************
Public Function OpenFolderDlg( _
    strTitle As String, _
    hOwner As Long, _
    strPath As String _
) As Boolean

    Dim bi As BROWSEINFO
    Dim lpi As Long
    Dim strGetPath As String * 512

    bi.hwndOwner = hOwner
    bi.pidlRoot = 0
    bi.lpszTitle = strTitle
    bi.ulFlags = 1
    bi.lpfn = 0
    bi.lParam = 0
    bi.iImage = 0

    lpi = SHBrowseForFolder(bi)

    If lpi <> 0 Then
        Call SHGetPathFromIDList(lpi, strGetPath)
        strPath = Left(strGetPath, InStr(strGetPath, Chr(0)) - 1)
        CoTaskMemFree lpi
        OpenFolderDlg = True
        Exit Function
    End If

    OpenFolderDlg = False

End Function

' ******************************************************
' ファイルを開くダイアログ
' ******************************************************
Public Function OpenFileDlg( _
    strTitle As String, _
    hOwner As Long, _
    strFilter As String, _
    nCutFilterIndex As Long, _
    strPath As String _
) As Boolean

    Dim ofn As OPENFILENAME
    Dim ret As Long
    Dim strFilePath As String * 512
    Dim strFilterWork As Variant
    Dim I As Integer

    If strPath <> "" Then
        strFilePath = strPath & String(512, Chr(0))
    End If
    
    ofn.lStructSize = LenB(ofn)
    ofn.hwndOwner = hOwner
    ofn.hInstance = App.hInstance
    strFilterWork = Split(strFilter, ",")
    ofn.lpstrFilter = ""
    For I = 0 To UBound(strFilterWork)
        ofn.lpstrFilter = ofn.lpstrFilter & strFilterWork(I) & Chr(0)
    Next
    ofn.lpstrFilter = ofn.lpstrFilter & Chr(0)
    ofn.nFilterIndex = nCutFilterIndex
    ofn.lpstrFile = strFilePath
    ofn.nMaxFile = 512
    ofn.lpstrTitle = strTitle
    ofn.flags = OFN_FILEMUSTEXIST Or OFN_HIDEREADONLY
    ret = GetOpenFileName(ofn)
    If ret <> 0 Then
        OpenFileDlg = True
        strPath = Left(ofn.lpstrFile, InStr(ofn.lpstrFile, Chr(0)) - 1)
    Else
        OpenFileDlg = False
    End If

End Function

' ******************************************************
' ファイルを保存するダイアログ
' ******************************************************
Public Function SaveFileDlg( _
    strTitle As String, _
    hOwner As Long, _
    strFilter As String, _
    nCutFilterIndex As Long, _
    strPath As String _
) As Boolean

    Dim ofn As OPENFILENAME
    Dim ret As Long
    Dim strFilePath As String * 512
    Dim strFilterWork As Variant
    Dim I As Integer

    If strPath <> "" Then
        strFilePath = strPath & String(512, Chr(0))
    End If

    ofn.lStructSize = LenB(ofn)
    ofn.hwndOwner = hOwner
    ofn.hInstance = App.hInstance
    strFilterWork = Split(strFilter, ",")
    ofn.lpstrFilter = ""
    For I = 0 To UBound(strFilterWork)
        ofn.lpstrFilter = ofn.lpstrFilter & strFilterWork(I) & Chr(0)
    Next
    ofn.lpstrFilter = ofn.lpstrFilter & Chr(0)
    ofn.nFilterIndex = nCutFilterIndex
    ofn.lpstrFile = strFilePath
    ofn.nMaxFile = 512
    ofn.lpstrTitle = strTitle
    ofn.flags = OFN_HIDEREADONLY
    ret = GetSaveFileName(ofn)
    If ret <> 0 Then
        SaveFileDlg = True
        strPath = Left(ofn.lpstrFile, InStr(ofn.lpstrFile, Chr(0)) - 1)
    Else
        SaveFileDlg = False
    End If

End Function

Private Sub Command1_Click()

    Dim strFilePath As String
    
    If OpenFileDlg( _
            "ファイルのオープン", _
            Me.hWnd, _
            "テキスト,*.txt,全て,*.*", _
            1, _
            strFilePath _
        ) Then
        Call MsgBox(strFilePath)
    End If

End Sub