时间戳

首页 > 解决方案 > 我想要文件夹对话路径

excel - 我想要文件夹对话路径

问题描述

我希望用户选择他们选择的文件夹，用户输入对话框，我可以在其中选择路径。

 Sub Getsheets()

Path = "D:\Workbooks\" 'want to add the user choice path, rest of code is fine
Filename = Dir(Path & ("*.csv"))

Do While Filename <> ""


 Workbooks.Open Filename:=Path & Filename, ReadOnly:=True

    For Each Sheet In ActiveWorkbook.Sheets

     Sheet.Copy after:=ThisWorkbook.Sheets(1)

    Next Sheet
     Workbooks(Filename).Close
    Filename = Dir()
    Loop

    End Sub

标签： excelvba

解决方案

Application.FileDialog使用msoFileDialogFolderPicker选项（将其限制为选择文件夹）可以轻松实现这一点。

一个简单的例子是：

Sub Getsheets()
    Dim Path As String
    Path = ""

    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = -1 Then
            Path = .SelectedItems(1)
        End If
    End With

    If Path <> "" Then
        Filename = Dir(Path & ("\*.csv"))
        Do While Filename <> ""
            Workbooks.Open Filename:=Path & "\" & Filename, ReadOnly:=True
            For Each Sheet In ActiveWorkbook.Sheets
                Sheet.Copy after:=ThisWorkbook.Sheets(1)
            Next Sheet
            Workbooks(Filename).Close
            Filename = Dir()
        Loop
    End If
End Sub

此代码实际上会打开文件夹对话框，并且仅Path在OK按下 ( .Show = -1) 时才会填充：

With Application.FileDialog(msoFileDialogFolderPicker)
    If .Show = -1 Then
        Path = .SelectedItems(1)
    End If
End With

检查是否选择了路径Path <> ""。

最后一个小改动，路径不包含结尾反斜杠，因此附加了以下内容：

Filename = Dir(Path & ("\*.csv"))

编辑以下 OP 评论

由于Path不以反斜杠结尾，调用 Workbook.Open 方法的行出现错误。固定线路是：

Workbooks.Open Filename:=Path & "\" & Filename, ReadOnly:=True

推荐阅读