VBA Excel获取文件path（以文件夹结尾）
从以前的问题，我知道如何去让用户点击一个“浏览器”button，并导航到他们可能要打开的特定文件。
码：
Private Sub CommandButton2_Click() Dim vaFiles As Variant vaFiles = Application.GetOpenFilename() ActiveSheet.Range("B9") = vaFiles End Sub 我想创build第二个浏览器button，让用户导航到一个文件夹。 这个文件夹将会保存我的程序创build的.pdf文件。 这是问题： GetOpenFilename需要用户点击一个文件。 如果文件夹中没有文件，那么用户不能做任何事情。
我希望这是清楚的…
谢谢
使用Application.FileDialog对象
Sub SelectFolder() Dim diaFolder As FileDialog ' Open the file dialog Set diaFolder = Application.FileDialog(msoFileDialogFolderPicker) diaFolder.AllowMultiSelect = False diaFolder.Show MsgBox diaFolder.SelectedItems(1) Set diaFolder = Nothing End Sub
在用户点击取消button而不是select文件夹的情况下，添加了ErrorHandler。 所以，不要得到一个可怕的错误信息，你会得到一个消息，必须select一个文件夹，然后例程结束。 下面的代码还将文件夹path存储在范围名称中（它刚刚链接到工作表上的单元格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
在VBA编辑器的工具菜单中，单击引用…向下滚动到“Microsoft Shell Controls And Automation”并select它。
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
来源链接 。
使用Application.GetSaveAsFilename()以与您使用Application.GetOpenFilename()相同的方式
这可能会帮助你：
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
如果你想浏览到一个文件夹默认情况下：例如“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