当打开一个打开对话框时，怎么使它只打开文件夹，而不是打开具体的文件？？

Question

我只想打开一个文件夹，而不是打开一个文件。

Answer 1

在类中封装目录选择对话框    你是否在纳闷,在VB公用对话框中怎么没有目录选择对话框呢,事实上在API查看器中也未声明这个API.本例用到的两个API如下SHBrowseForFolder    用于浏览文件夹、打印机和网络SHGetPathFromIDList    用于将项标识符列表转换为文件系统路径有了这两个API函数,你就可以构造一个目录选择对话框类以代替VB中的目录控件.类clsGetPath的完整代码如下:Option Explicit
'API声明部分
Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Private Type BROWSEINFO
    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 SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As LongPrivate Const BIF_RETURNONLYFSDIRS = 0
Private Const BIF_DONTGOBELOWDOMAIN = 1
Private Const BIF_STATUSTEXT = 2
Private Const BIF_RETURNFSANCESTORS = 3
Private Const BIF_BROWSEFORCOMPUTER = 4
Private Const BIF_BROWSEFORPRINTER = 5'变量声明
Private mvarCaption As String
Private mvarhWnd As Long
Private mvarFlags As Integer
Private mvarFolder As Variant'类的属性
Public Property Let Folder(ByVal vData As Variant)
    mvarFolder = vData
End PropertyPublic Property Set Folder(ByVal vData As Variant)
    Set mvarFolder = vData
End PropertyPublic Property Get Folder() As Variant
    If IsObject(mvarFolder) Then
        Set Folder = mvarFolder
    Else
        Folder = mvarFolder
    End If
End PropertyPublic Property Let Flags(ByVal vData As Integer)
    mvarFlags = vData
End PropertyPublic Property Get Flags() As Integer
    Flags = mvarFlags
End PropertyPublic Property Let hwnd(ByVal vData As Long)
    mvarhWnd = vData
End PropertyPublic Property Get hwnd() As Long
    hwnd = mvarhWnd
End PropertyPublic Property Let Caption(ByVal vData As String)
    mvarCaption = vData
End PropertyPublic Property Get Caption() As String
    Caption = mvarCaption
End Property'类的方法
Public Sub GetFolder()
    Dim bi As BROWSEINFO
    Dim pidl As Long
    Dim ret As String    ret = String$(255, Chr$(0))    With bi
        .hOwner = hwnd
        .ulFlags = Flags
        If Caption <> "" Then
            .lpszTitle = Caption & Chr$(0)
        Else
            .lpszTitle = "Select a Folder..." & Chr$(0)
        End If
    End With    pidl = SHBrowseForFolder(bi)    If SHGetPathFromIDList(ByVal pidl, ByVal ret) Then
        Folder = Left$(ret, InStr(ret, Chr$(0)) - 1)
    Else
        Folder = ""
    End If
End Sub在程序中使用类的代码:Private Sub cmdBrowse_Click()
    Dim c As clsGetPath      '声明对象变量
    Set c = New clsGetPath
    With c
        .Caption = "请选择一个文件夹"
        .Flags = 0
        .hwnd = Me.hwnd
    End With
    c.GetFolder
    txtPath.Text = c.Folder
End Sub

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
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 Long
Private Sub Form_Load()    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 sPath
End Sub

Answer 3

不是非常清楚楼主的意思，我想在一个FORM中放一个commondDialog控件，放一个button
在Button_Click事件中写入commonddialog.showopen 就可以看到所有目录，不知是不是你想要的效果。

Answer 4

TO  davidlv(菜鸟)
    commonddialog.showopen,这个函数只能选择单个或多个文件，但现在我想要做的是只选
择目录，不选择文件， rainstormmaster(rainstormmaster)的答案非常不错，我再试试lihonggen0(李洪根，MS MVP，标准答案来了)大虾的。

Answer 5

'引用 Microsoft Shell Controls And Automation
  Private shlShell As Shell32.Shell
  Private shlFolder As Shell32.Folder
  Private Const BIF_RETURNONLYFSDIRS = &H1Private Sub Command1_Click()      If shlShell Is Nothing Then
          Set shlShell = New Shell32.Shell
      End If
      Set shlFolder = shlShell.BrowseForFolder(Me.hWnd, "请选择路径", BIF_RETURNONLYFSDIRS)
      If Not shlFolder Is Nothing Then
          MsgBox shlFolder.Title
      End If
End Sub

Answer 6

'这里显示取得路径的方法'引用Microsoft Shell Controls And Automation  Private shlShell As Shell32.Shell
  Private shlFolder As Shell32.Folder
  Private Const BIF_RETURNONLYFSDIRS = &H1Private Sub Command1_Click()      If shlShell Is Nothing Then
          Set shlShell = New Shell32.Shell
      End If
      Set shlFolder = shlShell.BrowseForFolder(Me.hWnd, "请选择路径", BIF_RETURNONLYFSDIRS)
      If Not shlFolder Is Nothing Then
          MsgBox shlFolder.Items.Item.Path
      End If
End Sub