☰

无法使目录函数中的导入表动态化吗？

tag-icon • tag-icon microsoft-excel worksheet-function vba macros
无法使目录函数中的导入表动态化吗？

我可以将下面的代码修改为工作表的动态导入，以便我可以在我的个人宏手册中的任何工作表中运行它，而不是在名为的工作表中运行它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\，directory = GetFolderName()但还无法测试它，因为上面的代码不起作用。

答案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

相关内容