进行文件操作时,经常要用 VBA 选择目标文件夹,现提供实现代码:
1.FileDialog 属性
Sub Sample1()
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = True Then
MsgBox .SelectedItems(1)
End If
End With
End Sub
2.shell 方法
Sub Sample2()
Dim Shell, myPath
Set Shell = CreateObject("Shell.Application")
Set myPath = Shell.BrowseForFolder(&O0, "请选择文件夹", &H1 + &H10, "G:\")
If Not myPath Is Nothing Then MsgBox myPath.Items.Item.Path
Set Shell = Nothing
Set myPath = Nothing
End Sub
3.API 方法
Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" _
(ByVal pidl As Long, ByVal pszPath As String) As Long
Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" _
(lpBrowseInfo As BROWSEINFO) As Long
Declare Function GetDesktopWindow Lib "user32" () As Long
Public 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
Sub Sample3()
Dim buf As String
buf = GetFolder("请选择文件夹")
If buf = "" Then Exit Sub
MsgBox buf
End Sub
Function GetFolder(Optional Msg) As String
Dim bInfo As BROWSEINFO, pPath As String
Dim R As Long, X As Long, pos As Integer
bInfo.pidlRoot = 0&
bInfo.lpszTitle = Msg
bInfo.ulFlags = &H1
X = SHBrowseForFolder(bInfo)
pPath = Space$(512)
R = SHGetPathFromIDList(ByVal X, ByVal pPath)
If R Then
pos = InStr(pPath, Chr$(0))
GetFolder = Left(pPath, pos - 1)
Else
GetFolder = ""
End If
End Function
·【Excel应用大全】 | ·【Excel表格中鲜为人知的“照相机”功能】 |
·【Excel打“√”也用键盘敲】 | ·【Excel切片器新解】 |
·【办公一族晋级的资本“熟练使用Excle函数”】 | ·【让你的Excel操作更简单】 |
·【为Excel表格赋予只读锁定的权限】 | ·Excel 2007更加人性化的折叠编辑 |
·Excel VBA巧妙返回某行某列的值 | ·用VBA编程保护Excel文档工作簿 |
Copyright © 2002-2015 版权所有 学校地址:北京市海淀区西三旗建材城中路29号北大青鸟 招生热线:010-82011433/32 京公网安备110102004704 京ICP备05043413号 京公网安备110102004704 |