【问题标题】:VBA - Folder Picker - set where to start [duplicate]VBA - 文件夹选择器 - 设置从哪里开始[重复]
【发布时间】:2013-10-22 17:33:55
【问题描述】:

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

【问题讨论】:

  • 请添加您目前拥有的代码;它将作为一个很好的起点。

标签: vba ms-access


【解决方案1】:

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

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

【讨论】:

    【解决方案2】:

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

    【讨论】:

    • Access 无法识别 Excel 的枚举,您需要指定数字,因此要在 Access 中使用此代码,请将 msoFileDialogFolderPicker 替换为 4。
    【解决方案3】:

    如果您不需要将文件夹视图限制为您的用户,那么我建议使用 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。该函数返回用户选择的完全限定的文件夹名称,如果用户取消了对话框,则返回一个空字符串。

    【讨论】:

      【解决方案4】:

      这是一个更简单的方法。这段代码 sn-p 让用户选择一个文件夹,然后将该文件夹地址打印到屏幕上:

      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
      

      【讨论】:

      • Access 无法识别 Excel 的枚举,您需要指定数字,因此要在 Access 中使用此代码,请将 msoFileDialogFolderPicker 替换为 4。
      【解决方案5】:

      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 窃取;)

      【讨论】:

        猜你喜欢
        • 1970-01-01
        • 2020-11-29
        • 2011-10-04
        • 2016-08-11
        • 2012-08-31
        • 2021-02-09
        • 2011-06-01
        • 1970-01-01
        • 1970-01-01
        相关资源
        最近更新 更多