Не можете сделать листы импорта из каталога динамическими?

Question

Могу ли я изменить приведенный ниже код для динамического импорта листов, чтобы я мог запустить его на любом листе из своего личного макробукса вместо листа с именем import-sheets.xls?

Найденный код для импорта ниже.

Dim directory As String, fileName As String, sheet As Worksheet, total As Integer

Application.ScreenUpdating = False
Application.DisplayAlerts = False

directory = "c: est\"
fileName = Dir(directory & "*.xl??")

Do While fileName <> ""

Loop

Workbooks.Open (directory & fileName)

For Each sheet In Workbooks(fileName).Worksheets
    total = Workbooks("import-sheets.xls").Worksheets.count
    Workbooks(fileName).Worksheets(sheet.Name).Copy _
    after:=Workbooks("import-sheets.xls").Worksheets(total)
Next sheet

Workbooks(fileName).Close

fileName = Dir()

9. Turn on screen updating and displaying alerts again (outside the loop).
Application.ScreenUpdating = True
Application.DisplayAlerts = True

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

Я нашел следующий код онлайн:

Public Function GetFolderName(Optional OpenAt As String) As String
Dim lCount As Long

GetFolderName = vbNullString

With Application.FileDialog(msoFileDialogFolderPicker)
    .InitialFileName = OpenAt
    .Show
    For lCount = 1 To .SelectedItems.Count
        GetFolderName = .SelectedItems(lCount)
    Next lCount
End With

End sub

Я думаю, что было бы легко исправить, чтобы изменить directory = "c: est\ into directory = GetFolderName() но пока не могу это проверить, потому что приведенный выше код не работает.

Answer 1

Я использовал следующий код для решения своих проблем:

Я создал AvivoWB = ActiveWorkbook и использовал это в коде.

Как и ожидалось, мне нужно было изменить directory = "c: est\" на directory = GetFolderName() & "/"

Sub Import_Excel_sheets()

Dim directory As String
Dim fileName As String
Dim sheet As Worksheet
Set ActivoWB = ActiveWorkbook

Application.ScreenUpdating = False
Application.DisplayAlerts = False

directory = GetFolderName() & "/"
fileName = Dir(directory & "*.xl??")

Do While fileName <> ""
    Workbooks.Open (directory & fileName)

    For Each sheet In Workbooks(fileName).Worksheets
        Workbooks(fileName).Worksheets(sheet.Name).Copy _
        after:=ActivoWB.Sheets(ActivoWB.Sheets.Count)
    Next sheet

    Workbooks(fileName).Close
    fileName = Dir()
Loop

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

Код функции не изменился и должен быть добавлен в рабочую книгу:

Public Function GetFolderName(Optional OpenAt As String) As String
Dim lCount As Long

GetFolderName = vbNullString

With Application.FileDialog(msoFileDialogFolderPicker)
    .InitialFileName = OpenAt
    .Show
    For lCount = 1 To .SelectedItems.Count
        GetFolderName = .SelectedItems(lCount)
    Next lCount
End With
End Function