Я хочу иметь путь к папке - PullRequest
0 голосов
/ 11 октября 2019

Я хочу, чтобы пользователь выбрал папку по своему выбору, диалоговое окно ввода пользователя, в котором я могу выбрать путь.

 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

1 Ответ

0 голосов
/ 11 октября 2019

Это легко достигается с помощью 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

Произошла ошибка в строкегде метод Workbook.Open вызывается из-за того, что Path не заканчивается обратной косой чертой. Фиксированная линия:

Workbooks.Open Filename:=Path & "\" & Filename, ReadOnly:=True
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...