Option Explicit

'===========================================================================
'    ファイル名    : basSelFolderDialog.bas
'    ファイル説明  : フォルダ選択ダイアログ表示
'    作成者        : Uz
'                    E-Mail   : uz@violet.plala.or.jp
'                    HomePage : http://www1.plala.or.jp/uz/
'    作成日        : 1998/09/12 (Sat)
'    修正日        : 1998/09/12 (Sat)
'    備考          : なし
'===========================================================================

' -- API 定数宣言
Private Const BIF_RETURNONLYFSDIRS = &H1&

' -- API 型宣言
Private 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

' -- API 関数宣言
Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" ( _
    lpBROWSEINFO As BROWSEINFO _
) As Long

Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" ( _
    ByVal pidl As Long, _
    ByVal pszPath As String _
) As Long

'///////////////////////////////////////////////////////////////////////////
'      関数名    : SelFolderDialog
'      目的説明  : フォルダ選択ダイアログの表示
'      前提条件  : なし
'      結果      : なし
'      引数      : frmForm  Form    : オーナーフォーム
'                  strTitle String  : タイトル (初期値 = "フォルダを選択してください")
'      戻り値    : String   : 選択したフォルダのパス
'      備考      : なし
'///////////////////////////////////////////////////////////////////////////
Public Function SelFolderDialog(frmForm As Form, Optional strTitle As String = "フォルダを選択してください") As String
    Dim lngRet As Long
    Dim BInfo As BROWSEINFO
    Dim SelectPath As String * 128
    
    With BInfo
        .hwndOwner = frmForm.hwnd
        .lpszTitle = strTitle
        .ulFlags = BIF_RETURNONLYFSDIRS
    End With
    
    lngRet = SHBrowseForFolder(BInfo)
    
    lngRet = SHGetPathFromIDList(lngRet, SelectPath)
    SelFolderDialog = SelectPath
End Function

'///////////////////////////////////////////////////
' 呼び出し側
    strPath = SelFolderDialog(Me)