用VB實現目錄選擇+瀏覽

'下面用API實現目錄瀏覽,選擇目錄，如果有高手能夠在選擇目錄時新建一個，請續，謝謝!

'Common.bas*************************************************************

Option Explicit

Public Type BrowseInfo
     hwndOwner As Long
     pIDLRoot As Long
     pszDisplayName As Long
     lpszTitle As Long
     ulFlags As Long
     lpfnCallback As Long
     lParam As Long
     iImage As Long
End Type

Public Const BIF_RETURNONLYFSDIRS = 1
Public Const MAX_PATH = 260

Public Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)
Public Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Public Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Public Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long

Public Function BrowseForFolder(hwndOwner As Long, sPrompt As String) As String
     
    '定義變量
     Dim iNull As Integer
     Dim lpIDList As Long
     Dim lResult As Long
     Dim sPath As String
     Dim udtBI As BrowseInfo

    '初始化.....
     With udtBI
        .hwndOwner = hwndOwner
        .lpszTitle = lstrcat(sPrompt, "")
        .ulFlags = BIF_RETURNONLYFSDIRS
     End With

    '調用API
     lpIDList = SHBrowseForFolder(udtBI)
    '得到返回結果     
    If lpIDList Then
        sPath = String$(MAX_PATH, 0)
        lResult = SHGetPathFromIDList(lpIDList, sPath)
        Call CoTaskMemFree(lpIDList)
        iNull = InStr(sPath, vbNullChar)
        If iNull Then sPath = Left$(sPath, iNull - 1)
     End If
     BrowseForFolder = sPath

End Function

'**************************************************************************

下面在窗體中的按鈕中調用

Private Sub cmdBrowse_Click()
Dim strResFolder As String

strResFolder = BrowseForFolder(hWnd, "請選擇一個目錄.")

If strResFolder = "" Then
    Call MsgBox("你取消了選擇目錄..", vbExclamation)
Else
    Call MsgBox("目錄" & strResFolder & "被選擇!", vbExclamation)
End If

End Sub