CommonDialog问题

Question

此部件可以浏览文件，选择文件返回文件名，我现在只想浏览文件夹，返回文件夹名字，不知可否实现，谢谢

Answer 1

Option ExplicitPrivate Type BROWSEINFOTYPE
    hOwner As Long
    pidlRoot As Long
    pszDisplayName As String
    lpszTitle As String
    ulFlags As Long
    lpfn As Long
    lParam As Long
    iImage As Long
End TypePrivate Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBROWSEINFOTYPE As BROWSEINFOTYPE) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long)
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal Hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal dwLength As Long)
Private Declare Function LocalAlloc Lib "kernel32" (ByVal uFlags As Long, ByVal uBytes As Long) As Long
Private Declare Function LocalFree Lib "kernel32" (ByVal hMem As Long) As LongPrivate Const WM_USER = &H400
Private Const BFFM_SETSELECTIONA As Long = (WM_USER + 102)
Private Const BFFM_SETSELECTIONW As Long = (WM_USER + 103)
Private Const LPTR = (&H0 Or &H40)Private Function BrowseCallbackProcStr(ByVal Hwnd As Long, ByVal uMsg As Long, ByVal lParam As Long, ByVal lpData As Long) As Long
    If uMsg = 1 Then
        Call SendMessage(Hwnd, BFFM_SETSELECTIONA, True, ByVal lpData)
    End If
End FunctionPrivate Function FunctionPointer(FunctionAddress As Long) As Long
    FunctionPointer = FunctionAddress
End FunctionPublic Function BrowseForFolder(ByVal Hwnd As Long, ByVal Title As String, Optional selectedPath As String = " ") As String
    
    Dim Browse_for_folder           As BROWSEINFOTYPE
    Dim itemID                      As Long
    Dim selectedPathPointer         As Long
    Dim tmpPath                     As String * 256
    
    With Browse_for_folder
        .hOwner = Hwnd ' Window Handle
        .lpszTitle = Title
        .lpfn = FunctionPointer(AddressOf BrowseCallbackProcStr) ' Dialog callback function that preselectes the folder specified
        selectedPathPointer = LocalAlloc(LPTR, Len(selectedPath) + 1) ' Allocate a string
        CopyMemory ByVal selectedPathPointer, ByVal selectedPath, Len(selectedPath) + 1 ' Copy the path to the string
        .lParam = selectedPathPointer ' The folder to preselect
    End With
    
    itemID = SHBrowseForFolder(Browse_for_folder) ' Execute the BrowseForFolder API
    
    If itemID Then
        If SHGetPathFromIDList(itemID, tmpPath) Then ' Get the path for the selected folder in the dialog
            BrowseForFolder = Left$(tmpPath, InStr(tmpPath, vbNullChar) - 1) ' Take only the path without the nulls
        End If
        Call CoTaskMemFree(itemID) ' Free the itemID
    End If
    
    Call LocalFree(selectedPathPointer) ' Free the string from the memory
    
End Function
Label1 = BrowseForFolder(Me.Hwnd, "select a path ")

Answer 2

so lang ,没想到这么复杂

Answer 3

设置CommonDialog的flag属性可以达到你的目的
具体MSDN里找

Answer 4

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
Const BIF_RETURNONLYFSDIRS = 1
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 LongPrivate Sub Command1_Click()
    Dim iNull As Integer, lpIDList As Long, lResult As Long
    Dim sPath As String, udtBI As BrowseInfo    With udtBI
        'Set the owner window
        .hWndOwner = Me.Hwnd
        'lstrcat appends the two strings and returns the memory address
        .lpszTitle = lstrcat("C:\", "")
        'Return only if the user selected a directory
        .ulFlags = BIF_RETURNONLYFSDIRS
    End With    'Show the 'Browse for folder' dialog
    lpIDList = SHBrowseForFolder(udtBI)
    If lpIDList Then
        sPath = String$(MAX_PATH, 0)
        'Get the path from the IDList
        SHGetPathFromIDList lpIDList, sPath
        'free the block of memory
        CoTaskMemFree lpIDList
        iNull = InStr(sPath, vbNullChar)
        If iNull Then
            sPath = Left$(sPath, iNull - 1)
        End If
    End If    MsgBox sPathEnd Sub

Answer 5

dim positon as integer
position=instrrev(commondialog1.filename,"\")
print mid(commondialog1.filename,1,positon-1)
就是说commondialog1的filename属性返回的文件的完整路径,instrrev函数是从路径的末尾找到第一个"\"字符串,它之前的所有字符串就是文件夹的名字~~
在用mid()函数把最后一个"\"字符串之前的字符串取出来输出就可以了~~
我是这么想的，不知道对不对~~楼主自己在试一下吧~~
有什么问题在共同讨论~~~~

Answer 6

DirListBox 控件
            
在运行时，DirListBox 控件显示目录和路径。这个控件可以显示分层的目录列表。例如，可以创建对话框，在所有可用目录中，从文件列表打开一个文件。语法DirListBox说明设置 List、ListCount 和 ListIndex 属性，就可以访问列表中的项目。如果需要显示 DriveListBox 和 FileListBox 控件，那么可以编写代码，使它们与 DirListBox 同步，并使它们之间彼此同步