vba 使用 Application.FileDialog 选择一个文件夹

声明:本页面是StackOverFlow热门问题的中英对照翻译,遵循CC BY-SA 4.0协议,如果您需要使用它,必须同样遵循CC BY-SA许可,注明原文地址和作者信息,同时你必须将它归于原作者(不是我):StackOverFlow 原文地址: http://stackoverflow.com/questions/9399651/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me): StackOverFlow

提示:将鼠标放在中文语句上可以显示对应的英文。显示中英文
时间:2020-09-11 15:19:16  来源:igfitidea点击:

Picking a folder using Application.FileDialog

vbaexcel-vbaexcel

提问by tpascale

I'm using Application.FileDialog to let the user select a folder, as in:

我正在使用 Application.FileDialog 让用户选择一个文件夹,如下所示:

Dim F As FileDialog
Set F = Application.FileDialog(msoFileDialogFolderPicker)

In this case the default folder contains no subfolders, so what the user sees is an empty box. Ideally, the dialog would not just list folders, but would list files disabled/grayed out so that the user would be able to see the contents of the folder he is picking.

在这种情况下,默认文件夹不包含子文件夹,因此用户看到的是一个空框。理想情况下,对话框不仅会列出文件夹,还会列出禁用/变灰的文件,以便用户能够看到他正在选择的文件夹的内容。

Is there a way to do this on the cheap with a FileDialog or do I have to create my own form (ugh) ?

有没有办法用 FileDialog 廉价地做到这一点,还是我必须创建自己的表单(呃)?

采纳答案by Siddharth Rout

Here is something from my database. I have been using this for quite sometime now for VBA. This code is notmine and I found it long time ago on the web.

这是我的数据库中的一些内容。我已经有一段时间在VBA 中使用它了。这段代码不是我的,我很久以前在网上找到的。

Sub Sample()
    ret = BrowseForFolder("C:\")
End Sub

Function BrowseForFolder(Optional OpenAt As Variant) As Variant
    Dim ShellApp As Object

    Set ShellApp = CreateObject("Shell.Application"). _
    BrowseForFolder(0, "Please choose a folder", 0, OpenAt)

    On Error Resume Next
    BrowseForFolder = ShellApp.self.Path
    On Error GoTo 0

    Set ShellApp = Nothing

    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:
    BrowseForFolder = False
End Function