获取文件路径（以文件夹结尾）

Question

我知道如何让用户单击按钮以导航到要打开的特定文件。

代码：

Private Sub CommandButton2_Click()
    Dim vaFiles As Variant

    vaFiles = Application.GetOpenFilename()

    ActiveSheet.Range("B9") = vaFiles
End Sub

我想要第二个按钮，让用户导航到文件夹以保存我的程序创建的.pdf文件。

问题： GetOpenFilename要求用户单击文件。 如果文件夹中没有文件，则用户无能为力。

Answer 1

使用Application.FileDialog对象

Sub SelectFolder()
    Dim diaFolder As FileDialog
    Dim selected As Boolean

    ' Open the file dialog
    Set diaFolder = Application.FileDialog(msoFileDialogFolderPicker)
    diaFolder.AllowMultiSelect = False
    selected = diaFolder.Show

    If selected Then
        MsgBox diaFolder.SelectedItems(1)
    End If

    Set diaFolder = Nothing
End Sub

Answer 2

已经为此添加了ErrorHandler，以防用户点击取消按钮而不是选择文件夹。 因此，您不会收到可怕的错误消息，而是会收到一条消息，指出必须选择一个文件夹然后例程结束。 下面的代码还将文件夹路径存储在范围名称中（它只链接到工作表上的单元格A1）。

Sub SelectFolder()

Dim diaFolder As FileDialog

'Open the file dialog
On Error GoTo ErrorHandler
Set diaFolder = Application.FileDialog(msoFileDialogFolderPicker)
diaFolder.AllowMultiSelect = False
diaFolder.Title = "Select a folder then hit OK"
diaFolder.Show
Range("IC_Files_Path").Value = diaFolder.SelectedItems(1)
Set diaFolder = Nothing
Exit Sub

ErrorHandler:
Msg = "No folder selected, you must select a folder for program to run"
Style = vbError
Title = "Need to Select Folder"
Response = MsgBox(Msg, Style, Title)

End Sub

Answer 3

在VBA编辑器的“工具”菜单中，单击“引用”...向下滚动到“Microsoft Shell控件和自动化”并选择它。

Sub FolderSelection()
    Dim MyPath As String
    MyPath = SelectFolder("Select Folder", "")
    If Len(MyPath) Then
        MsgBox MyPath
    Else
        MsgBox "Cancel was pressed"
    End If
End Sub

'Both arguements are optional. The first is the dialog caption and
'the second is is to specify the top-most visible folder in the
'hierarchy. The default is "My Computer."

Function SelectFolder(Optional Title As String, Optional TopFolder _
                         As String) As String
    Dim objShell As New Shell32.Shell
    Dim objFolder As Shell32.Folder

'If you use 16384 instead of 1 on the next line,
'files are also displayed
    Set objFolder = objShell.BrowseForFolder _
                            (0, Title, 1, TopFolder)
    If Not objFolder Is Nothing Then
        SelectFolder = objFolder.Items.Item.Path
    End If
End Function

来源链接 。

Answer 4

如果要默认浏览到文件夹：例如“D：\\ Default_Folder”只是初始化“InitialFileName”属性

Dim diaFolder As FileDialog

' Open the file dialog
Set diaFolder = Application.FileDialog(msoFileDialogFolderPicker)
diaFolder.AllowMultiSelect = False
diaFolder.InitialFileName = "D:\Default_Folder"
diaFolder.Show

Answer 5

使用Application.GetSaveAsFilename()中，你所使用的相同方式Application.GetOpenFilename()

Answer 6

这可能会帮助你：

Sub SelectFolder()
    Dim diaFolder As FileDialog
    Dim Fname As String

    Set diaFolder = Application.FileDialog(msoFileDialogFolderPicker)
    diaFolder.AllowMultiSelect = False
    diaFolder.Show

    Fname = diaFolder.SelectedItems(1)

    ActiveSheet.Range("B9") = Fname

End Sub