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