在VB里如何实现按键后跳出一个树型路径框,让我们选择路径?

Question

我想做一个"浏览"按键.
点击之后跳出一个选择路径的那个东东.
请问如何实现,需要什么控件?

Answer 1

CommonDialog(工程/部件/Microsoft/CommonDialog Control 6.0)

Answer 2

声明：
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
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
End If
BrowseForFolder = sPath
End Function

Answer 3

不用控件的话，用API函数也可以，参考：Option ExplicitPrivate Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As LongPrivate Type OPENFILENAME
    lStructSize As Long
    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 TypeSub main()
    Dim OpenFile As OPENFILENAME
    Dim lReturn As Long
    Dim sFilter As String
    OpenFile.lStructSize = Len(OpenFile)
    
    sFilter = "Excel Files (*.xls)" & Chr(0) & "*.xls" & Chr(0)
    OpenFile.lpstrFilter = sFilter
    OpenFile.nFilterIndex = 1
    OpenFile.lpstrFile = String(257, 0)
    OpenFile.nMaxFile = Len(OpenFile.lpstrFile) - 1
    OpenFile.lpstrFileTitle = OpenFile.lpstrFile
    OpenFile.nMaxFileTitle = OpenFile.nMaxFile
    OpenFile.lpstrInitialDir = "C:\"
    OpenFile.lpstrTitle = "Use the Comdlg API not the OCX"
    OpenFile.flags = 0
    OpenFile.lpstrFile = "123.txt" '--->指定文件名
    lReturn = GetOpenFileName(OpenFile)
    If lReturn = 0 Then
        MsgBox "The User pressed the Cancel Button"
    Else
        MsgBox "The user Chose " & Trim(OpenFile.lpstrFile)
    End If
End Sub

Answer 4

CommonDialog 可以选择路径吗?
只可以选择文件吧

Answer 5

楼主用我的代码吧，正解。
faysky2可能没看清楚你的题目。

Answer 6

只选择路径（只显示文件夹），可以这样：Option ExplicitPrivate Type BrowseInfo
    hWndOwner As Long
    pIDLRoot As Long
    pszDisplayName As Long
    lpszTitle As String
    ulFlags As Long
    lpfnCallback As Long
    lParam As Long
    iImage As Long
End TypePrivate Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem 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
Private Declare Function GetActiveWindow Lib "user32" () As LongFunction BrowseForFolder(Optional sCaption As String = "") As String
Const BIF_RETURNONLYFSDIRS = 1
Const MAX_PATH = 260
Dim lPos As Integer, lpIDList As Long, lResult As Long
Dim sPath As String, tBrowse As BrowseInfo    If Trim(sCaption) = "" Then
        sCaption = LoadResString(6318)
    End If    With tBrowse
        .hWndOwner = GetActiveWindow        'Me.hWnd in VB
        .lpszTitle = sCaption
        .ulFlags = BIF_RETURNONLYFSDIRS     'Return only if the user selected a directory
    End With
    'Show the dialog
    lpIDList = SHBrowseForFolder(tBrowse)
    If lpIDList Then
        sPath = String$(MAX_PATH, 0)
        'Get the path from the IDList
        SHGetPathFromIDList lpIDList, sPath
        CoTaskMemFree lpIDList
        lPos = InStr(sPath, vbNullChar)
        If lPos Then
            BrowseForFolder = Left$(sPath, lPos - 1)
            If Right$(BrowseForFolder, 1) <> "\" Then
                BrowseForFolder = BrowseForFolder & "\"
            End If
        End If
    End If
End FunctionPrivate Sub Command1_Click()
    MsgBox BrowseForFolder("选择文件夹")
End Sub

Answer 7

BrowseForFolder这个函数怎么用?
可否解释一下,谢谢

Answer 8

上面有调用例子：按下Command1 按钮后，弹出对话框，选择文件夹后，点确定，即可得到路径
Private Sub Command1_Click()
    Dim strPath As String
    strPath = BrowseForFolder("选择文件夹")
    MsgBox strPath
End Sub

Answer 9

Private Sub Command1_Click()
    Dim strPath As String
    strPath = BrowseForFolder("选择文件夹")
    If Trim(strPath) = "" Then
        MsgBox "用户按了取消按钮！"
    Else
        MsgBox "用户选择的路径是：" & strPath
    End If
End Sub

Answer 10

OutPath = CreateObject("shell.application").BrowseForFolder(0, "选择文件夹", 0).Self.Path
If Not GetDriveType(left(OutPath, 3)) = 3 Then '判断选择的路径是合法的磁盘路径
   MsgBox "非法路径", vbCritical, "Error"
   Exit Sub
End If
If Len(OutPath) = 0 Then Exit Sub