'*******************************浏览文件夹***************************************************** Public Declare Function SHBrowseForFolder Lib "shell32.dll" Alias _ "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As LongPublic Declare Function SHGetSpecialFolderLocation Lib _ "shell32.dll" (ByVal hwndOwner As Long, ByVal NFolder _ As Long, PIdl As ITEMIDLIST) As LongPublic Declare Function SHGetFileInfo Lib "Shell32" Alias _ "SHGetFileInfoA" (ByVal pszPath As Any, ByVal _ dwFileAttributes As Long, psfi As SHFILEINFO, ByVal _ cbFileInfo As Long, ByVal uFlags As Long) As LongPublic Declare Function ShellAbout Lib "shell32.dll" Alias _ "ShellAboutA" (ByVal hwnd As Long, ByVal szApp As _ String, ByVal szOtherStuff As String, ByVal hIcon As Long) _ As Long Public Declare Function SHGetPathFromIDList Lib "shell32.dll" _ Alias "SHGetPathFromIDListA" (ByVal PIdl As Long, ByVal _ pszPath As String) As Long Public Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long)Public Const MAX_PATH = 260Public Type SHITEMID cb As Long abID() As Byte End TypePublic Type ITEMIDLIST mkid As SHITEMID End TypePublic 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 TypePublic Type SHFILEINFO hIcon As Long iIcon As Long dwAttributes As Long szDisplayName As String * MAX_PATH szTypeName As String * 80 End Type '*******************************浏览文件夹***************************************************** private Command1_click() Dim BI As BROWSEINFO Dim NFolder As Long Dim IDL As ITEMIDLIST Dim PIdl As Long Dim SPath As String Dim SHFI As SHFILEINFO Dim M_wCurOptIdx As Integer Dim TxtPath As String Dim TxtDisplayName As String Dim Noerror As Boolean Dim SHGFI_PIDL As Long Dim Shgfi_Icon As Long Dim Shgfi_Smallicon As LongWith BI .hOwner = Me.hwnd NFolder = GetFolderValue(M_wCurOptIdx)
If SHGetSpecialFolderLocation(ByVal Me.hwnd, ByVal NFolder, IDL) = Noerror Then .pidlRoot = IDL.mkid.cb End If
.pszDisplayName = String$(MAX_PATH, 0) .lpszTitle = "Browsing is limited to: " .ulFlags = 0 End With
Public Declare Function SHBrowseForFolder Lib "shell32.dll" Alias _
"SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As LongPublic Declare Function SHGetSpecialFolderLocation Lib _
"shell32.dll" (ByVal hwndOwner As Long, ByVal NFolder _
As Long, PIdl As ITEMIDLIST) As LongPublic Declare Function SHGetFileInfo Lib "Shell32" Alias _
"SHGetFileInfoA" (ByVal pszPath As Any, ByVal _
dwFileAttributes As Long, psfi As SHFILEINFO, ByVal _
cbFileInfo As Long, ByVal uFlags As Long) As LongPublic Declare Function ShellAbout Lib "shell32.dll" Alias _
"ShellAboutA" (ByVal hwnd As Long, ByVal szApp As _
String, ByVal szOtherStuff As String, ByVal hIcon As Long) _
As Long
Public Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal PIdl As Long, ByVal _
pszPath As String) As Long
Public Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long)Public Const MAX_PATH = 260Public Type SHITEMID
cb As Long
abID() As Byte
End TypePublic Type ITEMIDLIST
mkid As SHITEMID
End TypePublic 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 TypePublic Type SHFILEINFO
hIcon As Long
iIcon As Long
dwAttributes As Long
szDisplayName As String * MAX_PATH
szTypeName As String * 80
End Type
'*******************************浏览文件夹*****************************************************
private Command1_click()
Dim BI As BROWSEINFO
Dim NFolder As Long
Dim IDL As ITEMIDLIST
Dim PIdl As Long
Dim SPath As String
Dim SHFI As SHFILEINFO
Dim M_wCurOptIdx As Integer
Dim TxtPath As String
Dim TxtDisplayName As String
Dim Noerror As Boolean
Dim SHGFI_PIDL As Long
Dim Shgfi_Icon As Long
Dim Shgfi_Smallicon As LongWith BI
.hOwner = Me.hwnd
NFolder = GetFolderValue(M_wCurOptIdx)
If SHGetSpecialFolderLocation(ByVal Me.hwnd, ByVal NFolder, IDL) = Noerror Then
.pidlRoot = IDL.mkid.cb
End If
.pszDisplayName = String$(MAX_PATH, 0)
.lpszTitle = "Browsing is limited to: "
.ulFlags = 0
End With
TxtPath = ""
TxtDisplayName = ""PIdl = SHBrowseForFolder(BI)
If PIdl = 0 Then Exit Sub
SPath = String$(MAX_PATH, 0)
SHGetPathFromIDList ByVal PIdl, ByVal SPathTxtPath = Left(SPath, InStr(SPath, vbNullChar) - 1)
TxtDisplayName = Left$(BI.pszDisplayName, InStr(BI.pszDisplayName, vbNullChar) - 1)
SHGetFileInfo ByVal PIdl, 0&, SHFI, Len(SHFI), SHGFI_PIDL Or Shgfi_Icon Or Shgfi_Smallicon
SHGetFileInfo ByVal PIdl, 0&, SHFI, Len(SHFI), SHGFI_PIDL Or Shgfi_Icon
CoTaskMemFree PIdl
Text1.Text = TxtPath
'txtpath就是目录所在的路径
end sub