如何用对话框选取一个目录？？？？

i=instr(cd.filename,cd.filetitle)
mid(cd.filename,1,len(cd.filename)-len(cd.filetitle)-1)
自己再调一调，就是找到Filename中的文件名，再剔除来就行了

‘窗体中的代码 Private Sub Command1_Click()
        Dim FPath As String
        DirPath = ""
        DirPath = BrowseForFolder(Me.hwnd, "选择一个 Mp3 目录。")
        If DirPath = "" Then Exit Sub        ’写你处理 DirPath的代码！！！
end sub'在模块中：Option Explicitpublic DirPath As String
public InifilePath As StringPrivate 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 TypePrivate Const BIF_RETURNONLYFSDIRS = 1
Private Const MAX_PATH = 260Private 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 LongPrivate 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 = sPathEnd Function

'使用API
'在工程中新建模块如下
Option ExplicitPublic 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 TypePublic Const BIF_RETURNONLYFSDIRS = 1
Public Const MAX_PATH = 260Public Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)
Public Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Public Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Public Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As LongPublic 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    '调用API浏览文件夹
     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  '按取消键返回空字符串
     BrowseForFolder = sPathEnd Function
'-------------------------------
'在需要调用的地方使用如下方法
StrFoldername$ = BrowseForFolder(hWnd, "对话框标题")

Option ExplicitPrivate 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 TypeConst BIF_RETURNONLYFSDIRS = &H1Private pidl As LongPrivate Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" _
(ByVal pidl As Long, ByVal pszPath As String) As LongPrivate Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As LongPrivate Sub command1_Click()
Dim bi As BROWSEINFO
Dim r As Long
Dim pidl As Long
Dim path As String
Dim pos As Integer
'句柄
bi.hOwner = Me.hWnd
'展开根目录
bi.pidlRoot = 0&
'列表框标题
bi.lpszTitle = "请选择文件夹："
'规定只能选择文件夹，其他无效
bi.ulFlags = BIF_RETURNONLYFSDIRS
'调用API函数显示列表框
pidl = SHBrowseForFolder(bi)
'利用API函数获取返回的路径
path = Space$(512)
r = SHGetPathFromIDList(ByVal pidl&, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
Text1.Text = Left(path, pos - 1)
Command2.Enabled = True
Else
Text1.Text = ""
Command2.Enabled = False
End If
End Sub

选择目录啊,看错了？用SHBrowserForFolder函数

用API的好,用控件编译出来以后还得带着他。
而且还能锻炼API的应用能力!

调试易

如何用对话框选取一个目录？？？？

解决方案 »