VB实现目录选择+浏览

Option Explicit

Private 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

 

Private Const BIF_RETURNONLYFSDIRS = 1
Private Const MAX_PATH = 260

Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Private 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 CmdSelFile_Click()
    Dim strResFolder As String
   
    strResFolder = BrowseForFolder(hWnd, "请选择系统安装所在的目录...")
   
    If strResFolder = "" Then
        TxtPath.Text = ""
    Else
         TxtPath.Text = strResFolder
    End If

End Sub

 

Private Sub Form_Load()
    TxtPath.Text = ""
End Sub