VBA - 文件夹选择器 - 设置从哪里开始

VBA - Folder Picker - set where to start

提问by Finklesteinn

I have a small Access VBA application that requires users to select a folder. I was wondering if there is a way to tell VBA the path at which to start the folder picker. i.e. start the folder picker at C:\data\forms. Currently it seems to be starting from the directory that was previously used. Also is there a way to limit what the folder picker can access. So it can access anything within C:\databut not anything else in C:

我有一个小的 Access VBA 应用程序，需要用户选择一个文件夹。我想知道是否有办法告诉 VBA 启动文件夹选择器的路径。即启动文件夹选择器C:\data\forms。目前它似乎是从以前使用的目录开始的。还有一种方法可以限制文件夹选择器可以访问的内容。所以它可以访问里面的任何东西，C:\data但不能访问里面的任何东西C:

回答by Siddharth Rout

I have been using the following code (Not My Code) successfully for many years.

多年来，我一直在成功使用以下代码（不是我的代码）。

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

回答by artifex_knowledge

Here is a quick and dirty method I use all the time. The function below will only get the user to select the folder they want to start at - I think the simplest way to limit access to a given path is to perhaps check GetFolderNamebelow against the path(s) you want to restrict e.g.

这是我一直使用的一种快速而肮脏的方法。下面的功能只会让用户选择他们想要开始的文件夹 - 我认为限制对给定路径的访问的最简单方法可能是检查GetFolderName下面要限制的路径，例如

If GetFolderName = "C:\" then 
  MsgBox("This folder is not for you buddy")
  Exit Sub
end if

Also not my code :)

也不是我的代码:)

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

回答by ChE Junkie

If you do not need to restrict the folder-view to your user, then I would suggest using the FileDialog method (the interface is more intuitive then what invoking the shell gives you). For additional details, you can read more on CPearson's site. He has a lengthy articleon browsing for folders using VBA (mulitple ways; the FileDialog option is at the very end):

如果您不需要将文件夹视图限制为您的用户，那么我建议使用 FileDialog 方法（界面比调用 shell 为您提供的更直观）。有关更多详细信息，您可以在 CPearson 的网站上阅读更多内容。他有一篇关于使用 VBA 浏览文件夹的长篇文章（多种方式；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

This function takes two parameters. The first, Title is a string specifying the title to be displayed with the file dialog. The second InitialFolder, which is optional, specifies the initial folder to which the dialog should open. The third parameter, also optional, InitialView specifies the view type. See MsoFileDialogView in the Object Browser for the valid values of this parameter. The function returns the fully-qualified folder name selected by the user or an empty string if the user cancelled the dialog.

这个函数有两个参数。第一个，Title 是一个字符串，指定要与文件对话框一起显示的标题。第二个 InitialFolder 是可选的，它指定对话框应该打开的初始文件夹。第三个参数，也是可选的，InitialView 指定视图类型。有关此参数的有效值，请参阅对象浏览器中的 MsoFileDialogView。如果用户取消对话框，该函数返回用户选择的完全限定文件夹名称或空字符串。

回答by Matt C.

Here is a much simpler way. This code snippet lets user pick a folder and then prints that folder address to the screen:

这是一个更简单的方法。此代码片段让用户选择一个文件夹，然后将该文件夹地址打印到屏幕上：

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

回答by Sam

For mac users:

对于 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

Stolen from http://www.rondebruin.nl/mac/mac017.htm;)

从http://www.rondebruin.nl/mac/mac017.htm窃取；)