Tidak dapat membuat lembar impor dari fungsi direktori menjadi dinamis?

Bisakah saya mengubah kode di bawah ini menjadi impor dinamis lembar, jadi saya bisa menjalankannya di lembar mana pun dari buku catatan pribadi saya alih-alih lembar yang disebut import-sheets.xls?

Temukan kode untuk mengimpor di bawah.

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

Saya juga ingin mengubah direktori menjadi suatu fungsi sehingga saya dapat mencari direktori secara manual melalui explorer, tanpa memodifikasi skrip setiap kali.

Saya menemukan kode berikut ini secara online:

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

Saya pikir ini akan menjadi perbaikan yang mudah untuk diubah directory = "c: est\menjadi directory = GetFolderName()tetapi belum dapat mengujinya, karena kode di atas tidak berfungsi.

— Dubblej
sumber

Saya menggunakan kode berikut untuk menyelesaikan masalah saya:

Saya membuat AvivoWB = ActiveWorkbookdan menggunakan ini dalam kode.

Seperti harapan saya, saya perlu mengubah directory = "c: est\"menjadidirectory = 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

Kode untuk fungsi tidak berubah dan juga harus ditambahkan ke buku kerja:

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

— Dubblej
sumber