如何用CommonDialog显示一个只要选择路径的提示，而不是显示打开文件或者保存文件的提示？

Question

如题目！就让用户选择一个路径就可以了！

Answer 1

呵呵，自己做一个窗口，然后用DirListBox 和 DriveListBox 就可以了。
另外一个方法是调用API

Answer 2

可以把commondialog的标题属性改了

Answer 3

你说的是打开一个目录么?就像系统管理器一样?Private Sub drvdrive_Change()
dirdirectory.Path = drvdrive.DriveEnd SubPrivate Sub dirdirectory_Change()
filfile.Path = dirdirectory.Path
End Su
建一个COMBOX和一个TEXT

Answer 4

//talent303(风筝) ( ) 和我说的一样。

Answer 5

二位能不能具体给点代码提示啊，最好是commondialog，因为DirListBox 和 DriveListBox 还要另外建一个窗体，我就在现在的窗体上用

Answer 6

Private Sub Command2_Click()
dim shl
Dim fd
Set shl = CreateObject("Shell.application")
Set fd = shl.BrowseForFolder(0, "请选择文件夹", 0, 0)
MsgBox fd.Self.Path
End Sub

Answer 7

'调用api,实现windows的'浏览"功能
'将这个复制到一个模块文件中
Option ExplicitPrivate Const BIF_STATUSTEXT = &H4&
Private Const BIF_RETURNONLYFSDIRS = 1
Private Const BIF_DONTGOBELOWDOMAIN = 2
Private Const MAX_PATH = 260Private Const WM_USER = &H400
Private Const BFFM_INITIALIZED = 1
Private Const BFFM_SELCHANGED = 2
Private Const BFFM_SETSTATUSTEXT = (WM_USER + 100)
Private Const BFFM_SETSELECTION = (WM_USER + 102)Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, _
                                     ByVal wParam As Long, ByVal lParam 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 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 m_CurrentDirectory As String'====================== 选择目录的函数 ========================================================================
'Owner ----------- 调用该函数的窗体
'Title ----------- 显示在目录选择对话框上的标题 (可选)
'StarDir --------- 默认打开的目录 (可选)
Public Function BrowseForFolder(Owner As Form, Optional Title As String, Optional StartDir As String) As String  Dim lpIDList As Long
  Dim szTitle As String
  Dim sBuffer As String
  Dim tBrowseInfo As BrowseInfo
  m_CurrentDirectory = StartDir & vbNullChar  szTitle = Title
  With tBrowseInfo
    .hWndOwner = Owner.hWnd
    .lpszTitle = IIf(Title <> "", Title, "路径选择：")
    .ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN + BIF_STATUSTEXT
    If StartDir <> "" Then
    .lpfnCallback = GetAddressofFunction(AddressOf BrowseCallbackProc)
    End If
  End With  lpIDList = SHBrowseForFolder(tBrowseInfo)
  If (lpIDList) Then
    sBuffer = Space(MAX_PATH)
    SHGetPathFromIDList lpIDList, sBuffer
    sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)
    BrowseForFolder = sBuffer
  Else
    BrowseForFolder = ""
  End If
  
End Function
 
Private Function BrowseCallbackProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal lp As Long, ByVal pData As Long) As Long
  
  Dim lpIDList As Long
  Dim ret As Long
  Dim sBuffer As String
  
  On Error Resume Next
  
  Select Case uMsg
  
    Case BFFM_INITIALIZED
      Call SendMessage(hWnd, BFFM_SETSELECTION, 1, m_CurrentDirectory)
      
    Case BFFM_SELCHANGED
      sBuffer = Space(MAX_PATH)
      
      ret = SHGetPathFromIDList(lp, sBuffer)
      If ret = 1 Then
        Call SendMessage(hWnd, BFFM_SETSTATUSTEXT, 0, sBuffer)
      End If
      
  End Select
  
  BrowseCallbackProc = 0
  
End FunctionPrivate Function GetAddressofFunction(add As Long) As Long
  GetAddressofFunction = add
End Function'然后,调用时
Dim strResFolder As String  '返回的字符串目录strResFolder = BrowseForFolder(Me, "请选择一个初始目录用于导入导出数据:",初始目录)

Answer 8

请问如果用户选择了取消就会出错，请问如何判断捕捉该错误啊，？？？
Dim shl
Dim fd
Set shl = CreateObject("Shell.application")
Set fd = shl.BrowseForFolder(0, "请选择文件夹", 0, "C:\windows")
If Not fd Is Nothing Then
MsgBox fd.Self.Path
End If