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

时间:2013-10-15 02:24:56

标签: vba ms-access access-vba

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

中的任何内容

5 个答案:

答案 0 :(得分:24)

我多年来一直使用以下代码( Not My Code )。

enter image description here

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

答案 1 :(得分:12)

这是我一直使用的快速而肮脏的方法。下面的函数只会让用户选择他们想要开始的文件夹 - 我认为限制访问给定路径的最简单方法是在下面针对你想要限制的路径检查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

答案 2 :(得分:5)

如果您不需要将文件夹视图限制为您的用户,那么我建议使用FileDialog方法(界面更直观,然后调用shell提供给您)。有关其他详细信息,您可以在CPearson的网站上阅读更多信息。他有lengthy article使用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

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

答案 3 :(得分:3)

这是一种更简单的方法。此代码段允许用户选择一个文件夹,然后将该文件夹地址打印到屏幕:

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

答案 4 :(得分:1)

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

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

被盗