ไม่สามารถทำให้แผ่นงานนำเข้าจากฟังก์ชั่นไดเรกทอรีเคลื่อนไหวได้หรือ

ฉันสามารถแก้ไขโค้ดด้านล่างเป็นการนำเข้าแบบไดนามิกของแผ่นเพื่อให้สามารถทำงานในแผ่นใด ๆ จาก macrobook ส่วนบุคคลของฉันแทนแผ่นที่เรียกว่า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

ฉันต้องการเปลี่ยนไดเรกทอรีเป็นฟังก์ชันเพื่อให้ฉันสามารถค้นหาไดเรกทอรีด้วยตนเองผ่าน explorer ได้โดยไม่ต้องแก้ไขสคริปต์ในแต่ละครั้ง

ฉันพบรหัสต่อไปนี้ทางออนไลน์:

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\เข้าdirectory = GetFolderName()แต่ไม่สามารถทดสอบได้เลยเพราะโค้ดข้างต้นไม่ทำงาน

ฉันใช้รหัสต่อไปนี้เพื่อแก้ไขปัญหาของฉัน:

ฉันสร้าง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