怎样用CommonDialog或其他东东得到一个目录的路径？

Question

  
   把下面的代码放在一个Bas中：Option Explicit'**********获得系统特殊目录**********************
Private Type SHITEMID
    cb As Long
    abID As Byte
End TypePrivate Type ITEMIDLIST  'idl
    mkid As SHITEMID
End Type#If UNICODE Then
    Private Declare Function SHGetPathFromIDList Lib "Shell32" Alias "SHGetPathFromIDListW" (ByVal pidl As Long, ByVal szPath As Long) As Long
#Else
    Private Declare Function SHGetPathFromIDList Lib "Shell32" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal szPath As String) As Long
#End IfPrivate Declare Function SHGetSpecialFolderLocation Lib "SHELL32.DLL" (ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As ITEMIDLIST) As LongPrivate Const MAX_PATH = 255
'Public Const MAX_NAME = 40
Private Const NOERROR = 0'*******************************
Private Enum SHELLFOLDERS            ' Shell Folder Path Constants...
    CSIDL_DESKTOP = &H0&            ' ..\WinNT\profiles\username\Desktop
    CSIDL_PROGRAMS = &H2&           ' ..\WinNT\profiles\username\Start Menu\Programs
    CSIDL_STARTMENU = &HB&          ' ..\WinNT\profiles\username\Start Menu
    CSIDL_CONTROLS = &H3
    CSIDL_PRINTERS = &H4
    CSIDL_PERSONAL = &H5
    CSIDL_FAVORITES = &H6
    CSIDL_STARTUP = &H7
    CSIDL_RECENT = &H8
    CSIDL_SENDTO = &H9
    CSIDL_BITBUCKET = &HA
    CSIDL_DESKTOPDIRECTORY = &H10
    CSIDL_DRIVES = &H11
    CSIDL_NETWORK = &H12
    CSIDL_NETHOOD = &H13
    CSIDL_FONTS = &H14
    CSIDL_TEMPLATES = &H15
End EnumPrivate Declare Function GetSystemDirectory Lib "Kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long'******* API声明：使用系统文件存取对话框 *********
Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Private Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As LongPrivate Type OPENFILENAME
    lStructSize As Long
    hwnd 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 TypePrivate Const OFN_HIDEREADONLY = &H4
Private Const OFN_PATHMUSTEXIST = &H800
Private Const OFN_FILEMUSTEXIST = &H1000
Private Const OFN_EXPLORER = &H80000
Private Const OFN_LONGNAMES = &H200000
Private Const OFN_NODEREFERENCELINKS As Long = &H100000
Private Const OFN_ENABLEHOOK As Long = &H20
Private Const OFN_OVERWRITEPROMPT = &H2
Private Const OFS_FILE_OPEN_FLAGS = OFN_EXPLORER Or OFN_LONGNAMES Or OFN_NODEREFERENCELINKS'****************************************'******* API声明：使用系统目录浏览对话框 *********
Private Declare Function SHBrowseForFolder Lib "SHELL32.DLL" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long 'ITEMIDLIST
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 Type
Private Const BIF_VALIDATE = &H20
Private Const BIF_USENEWUI = &H40
Private Const BIF_STATUSTEXT = &H4
Private Const BIF_RETURNONLYFSDIRS = &H1
Private Const BIF_RETURNFSANCESTORS = &H8
Private Const BIF_EDITBOX = &H10
Private Const BIF_DONTGOBELOWDOMAIN = &H2
Private Const BIF_BROWSEINCLUDEFILES = &H4000
Private Const BIF_BROWSEFORPRINTER = &H2000
Private Const BIF_BROWSEFORCOMPUTER = &H1000
Public Function BrowseFolder(ByVal st As String, lHwnd As Long, Optional ByVal iStyle As Long = CSIDL_DESKTOP) As String
Dim BI As BROWSEINFO
Dim idl As ITEMIDLIST
Dim rtn&, pidl&, sPath$    BI.hOwner = lHwnd
    rtn& = SHGetSpecialFolderLocation(ByVal lHwnd, iStyle, idl)
    BI.pidlRoot = idl.mkid.cb
    BI.lpszTitle = st
    BI.ulFlags = BIF_RETURNONLYFSDIRS
    pidl& = SHBrowseForFolder(BI)
    sPath$ = Space$(512)
    rtn& = SHGetPathFromIDList(ByVal pidl&, ByVal sPath$)
    If rtn& Then
        BrowseFolder = RelPath(StripTerminator(sPath$))
    Else
        BrowseFolder = ""
    End If
End Function

Answer 1

commondialog.filename就可以了,很简单的
路径很容易
for a =1  to len(commondialog.filename)
b=right(commondialog.filename,a)
if mid(b,1,1)="\" then
b=mid(commondialog.filename,1,len(commondialog.filename)-a)
exit for
end if
next
Path=b

Answer 2

  
  忘拉，最后面应该是：
Public Function BrowseFolder(ByVal st As String, lHwnd As Long, Optional ByVal iStyle As Long = CSIDL_DESKTOP) As String
Dim BI As BROWSEINFO
Dim idl As ITEMIDLIST
Dim rtn&, pidl&, sPath$    BI.hOwner = lHwnd
    rtn& = SHGetSpecialFolderLocation(ByVal lHwnd, iStyle, idl)
    BI.pidlRoot = idl.mkid.cb
    BI.lpszTitle = st
    BI.ulFlags = BIF_RETURNONLYFSDIRS
    pidl& = SHBrowseForFolder(BI)
    sPath$ = Space$(512)
    rtn& = SHGetPathFromIDList(ByVal pidl&, ByVal sPath$)
    If rtn& Then
        BrowseFolder = RelPath(StripTerminator(sPath$))
    Else
        BrowseFolder = ""
    End If
End FunctionPrivate Function StripTerminator(ByVal sInput As String) As String    Dim ZeroPos As Integer
    ZeroPos = InStr(1, sInput, vbNullChar)
    If ZeroPos > 0 Then
        StripTerminator = Left$(sInput, ZeroPos - 1)
    Else
        StripTerminator = sInput
    End If
    
End Function

Answer 3

用DriveListBox + DirListBox,难看一点，不过简单

Answer 4

程序编译通不过。RelPath（） -----------未定义

Answer 5

告诉你一个最简单的方法:
在VB中引用"Microsoft shell Controls and Automation"
然后定义:
dim xshell as new shell32.shell
再调用
xshell.browseFprFoder

Answer 6

回复人：　rushing(勇敢的心)　(2001-11-30 14:19:35)  得0分 
程序编译通不过。RelPath（） -----------未定义
 
   老兄，去掉这个就可以啦，这是我自己写的一个函数。我上面也有更正么。

Answer 7

myfile = Dir(.CommonDialog1.FileName)

Answer 8

  哇，这么老的帖子也有人翻出来！   喂，rushing(勇敢的心)　给分拉！

Answer 9

去掉RelPath()，那么BrowseFolder()就不工作了。

Answer 10

这是我写的：
'写在窗体中
Private Sub Cmd1_Click()
    Dim TempStr As string
    
    If ShowDir(me.hWnd, TempStr, 提示文字) Then
        '成功！路径在TempStr
    Else
        '不成功
    End If
    
End Sub'写在模块中
Public Declare Function SHBrowseForFolder _
        Lib "shell32.dll" Alias "SHBrowseForFolderA" _
        (lpBrowseInfo As BROWSEINFO) As Long
Public Declare Function SHGetPathFromIDList _
        Lib "shell32.dll" _
        (ByVal pidl As Long, _
        pszPath As String) As Long
Public Type BROWSEINFO
    hOwner As Long
    pidlRoot As Long
    pszDisplayName As String
    lpszTitle As String
    ulFlage As Long
    lpfn As Long
    lparam As Long
    iImage As Long
End TypePublic Function ShowDir(MehWnd As Long, _
        DirPath As String, _
        Optional Title As String = "请选择文件夹：", _
        Optional flage As Long = &H1, _
        Optional DirID As Long) As Long
    Dim BI As BROWSEINFO
    Dim TempID As Long
    Dim TempStr As String
    
    TempStr = String$(255, Chr$(0))
    With BI
        .hOwner = MehWnd
        .pidlRoot = 0
        .lpszTitle = Title + Chr$(0)
        .ulFlage = flage
        
    End With
    
    TempID = SHBrowseForFolder(BI)
    DirID = TempID
    
    If SHGetPathFromIDList(ByVal TempID, ByVal TempStr) Then
        DirPath = Left$(TempStr, InStr(TempStr, Chr$(0)) - 1)
        ShowDir = -1
        
    Else
        ShowDir = 0
        
    End If
    
End Function

Answer 11

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()
    'KPD-Team 1998
    'URL: http://www.allapi.net/
    '[email protected]
    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