|
|
发表于 2017-8-26 09:29:00
|
显示全部楼层
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
Private Declare Function SHBrowseForFolder Lib "shell32" Alias "SHBrowseForFolderA" (lpBi As BROWSEINFO) As Long
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Private Sub Command1_Click()
Dim j As Long, strXlsFileName As String
Dim strPath As String, FileName As String, ExtName As String
ExtName = ".xls" '指定要查找的文件扩展名
strPath = App.Path & "\" ' 指定路径为当前脚本目录。
strPath = BrowseForFolder '‘ "E:\资料\"
If Len(strPath) = 0 Then Exit Sub
FileName = Dir(strPath, vbNormal) ' 找寻第一项。
Do While FileName "" ' 开始循环。
If InStr(LCase(FileName), ExtName) Then '如果MyName中的扩展名是XLS则打开表格文件
j = j + 1
strXlsFileName = strXlsFileName & vbCrLf & FileName
End If
FileName = Dir ' 查找下一个
Loop
MsgBox "找到xls文件" & j & "个" & vbCrLf & strXlsFileName
End Sub
'选择文件夹对话框
'函数:BrowseForFolder
Public Function BrowseForFolder(Optional 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 = 0
.lpszTitle = lstrcat(sPrompt, "")
.ulFlags = 1
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 = sPath
End Function |
|
置顶卡
