我有一个小的Access VBA应用程序，需要用户选择文件夹。我想知道是否有一种方法可以告诉VBA从哪个路径开始打开文件夹对话框，例如从C:\data\forms开始。目前似乎是从先前使用的目录开始运行。此外，是否有一种方法可以限制文件夹对话框可以访问的内容。使其只能访问C:\data中的任何内容，而不能访问其他C:中的内容。
5个回答
24
我已经成功使用以下代码（非我编写）多年。
Sub Sample()
Dim Ret
'~~> Specify your start folder here
Ret = BrowseForFolder("C:\")
End Sub
Function BrowseForFolder(Optional OpenAt As Variant) As Variant
'Function purpose: To Browser for a user selected folder.
'If the "OpenAt" path is provided, open the browser at that directory
'NOTE: If invalid, it will open at the Desktop level
Dim ShellApp As Object
'Create a file browser window at the default folder
Set ShellApp = CreateObject("Shell.Application"). _
BrowseForFolder(0, "Please choose a folder", 0, OpenAt)
'Set the folder to that selected. (On error in case cancelled)
On Error Resume Next
BrowseForFolder = ShellApp.self.Path
On Error GoTo 0
'Destroy the Shell Application
Set ShellApp = Nothing
'Check for invalid or non-entries and send to the Invalid error
'handler if found
'Valid selections can begin L: (where L is a letter) or
'\\ (as in \\servername\sharename. All others are invalid
Select Case Mid(BrowseForFolder, 2, 1)
Case Is = ":"
If Left(BrowseForFolder, 1) = ":" Then GoTo Invalid
Case Is = "\"
If Not Left(BrowseForFolder, 1) = "\" Then GoTo Invalid
Case Else
GoTo Invalid
End Select
Exit Function
Invalid:
'If it was determined that the selection was invalid, set to False
BrowseForFolder = False
End Function
- Siddharth Rout
17
这里是我经常使用的一个快速而简单的方法。下面的函数将仅让用户选择他们想要开始的文件夹-我认为限制访问给定路径最简单的方法是检查下面的GetFolderName是否与您想要限制的路径相匹配。
If GetFolderName = "C:\" then
MsgBox("This folder is not for you buddy")
Exit Sub
end if
这也不是我的代码 :)
Public Function GetFolderName(Optional OpenAt As String) As String
Dim lCount As Long
GetFolderName = vbNullString
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = OpenAt
.Show
For lCount = 1 To .SelectedItems.Count
GetFolderName = .SelectedItems(lCount)
Next lCount
End With
End Function
- artifex_knowledge
1
6Access无法识别Excel的枚举类型，因此您需要指定数字，在Access中将msoFileDialogFolderPicker替换为4以使此代码正常工作。 - Absinthe
8
如果您不需要将文件夹视图限制为您的用户，则建议使用FileDialog方法（界面比调用shell给您的更直观）。有关更多详细信息，请阅读CPearson网站上有关使用VBA浏览文件夹的lengthy article（多种方式； FileDialog选项在最后）：
Function BrowseFolder(Title As String, _
Optional InitialFolder As String = vbNullString, _
Optional InitialView As Office.MsoFileDialogView = _
msoFileDialogViewList) As String
Dim V As Variant
Dim InitFolder As String
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = Title
.InitialView = InitialView
If Len(InitialFolder) > 0 Then
If Dir(InitialFolder, vbDirectory) <> vbNullString Then
InitFolder = InitialFolder
If Right(InitFolder, 1) <> "\" Then
InitFolder = InitFolder & "\"
End If
.InitialFileName = InitFolder
End If
End If
.Show
On Error Resume Next
Err.Clear
V = .SelectedItems(1)
If Err.Number <> 0 Then
V = vbNullString
End If
End With
BrowseFolder = CStr(V)
End Function
这个函数需要两个参数。第一个参数Title是一个字符串，用于指定文件对话框中要显示的标题。第二个参数InitialFolder是可选的，用于指定对话框应该打开的初始文件夹。第三个参数也是可选的，InitialView指定视图类型。在对象浏览器中查看MsoFileDialogView以获取此参数的有效值。函数返回用户选择的完全限定文件夹名称，如果用户取消了对话框，则返回空字符串。
- ChE Junkie
6
这里有一种更简单的方法。这段代码片段允许用户选择一个文件夹，然后将该文件夹地址打印到屏幕上：
Sub PrintSelectedFolder()
Dim selectedFolder
With Application.FileDialog(msoFileDialogFolderPicker)
.Show
selectedFolder = .SelectedItems(1)
End With
'print to screen the address of folder selected
MsgBox (selectedFolder)
End Sub
- Matt C.
1
3Access不识别Excel的枚举类型，您需要指定数字，所以为了使此代码在Access中正常工作，请将msoFileDialogFolderPicker替换为4。 - Absinthe
2
对于Mac用户：
Sub Select_Folder_On_Mac()
Dim folderPath As String
Dim RootFolder As String
On Error Resume Next
RootFolder = MacScript("return (path to desktop folder) as String")
'Or use RootFolder = "Macintosh HD:Users:YourUserName:Desktop:TestMap:"
folderPath = MacScript("(choose folder with prompt ""Select the folder""" & _
"default location alias """ & RootFolder & """) as string")
On Error GoTo 0
If folderPath <> "" Then
MsgBox folderPath
End If
End Sub
- Sam
网页内容由stack overflow 提供, 点击上面的可以查看英文原文，
原文链接
原文链接