从可选位置导入多个 Excel 工作表

Question

我正在尝试在 Excel 中创建一个按钮来触发用户选择文件夹位置的屏幕，并将其所有 Excel 文件添加到工作表中。

Sub Getsheets()
Path = GetFolder("N:\", "Select an Input Folder")
Filename = Dir(Path & "*.xlsm")
Do While Filename <> ""
Workbooks.Open Filename:=Path & Filename, ReadOnly:=True
For Each Sheet In ActiveWorkbook.Sheets
Sheet.Copy After:=ThisWorkbook.Sheets(1)
Next Sheet
Application.DisplayAlerts = False
Workbooks(Filename).Close
Filename = Dir()
Loop
End Sub

Function GetFolder(strPath As String, fldSt As String) As String
    Dim fldr As FileDialog
    Dim sItem As String
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = fldSt
        .AllowMultiSelect = False
        .InitialFileName = strPath
        If .Show <> -1 Then GoTo NextCode
        sItem = .SelectedItems(1)
    End With
NextCode:
    GetFolder = sItem
    Set fldr = Nothing
End Function

这就是我目前所拥有的，如果我不合并getfolder 函数，我可以检索指定文件夹中的所有Excel 文件，但是一旦我将函数放入，什么也没有发生。如何解决这个问题？

Answer 1

文件对话框确实返回一个没有尾随“\”的路径（取决于平台）。 您需要在搜索“*.xlsm”之前手动附加尾随“\”

所以第三行代码是：

Filename = Dir(Path & Application.PathSeparator & "*.xlsm")

编辑 还有其他对 Path 的引用，必须添加 PathSeparator。

实际上，最好在打开工作簿时以编程方式对其进行参考。此外，最好声明变量（在模块的第一行使用“Option Explicit”来强制执行此操作）。

这是您的代码，已更新以符合上述想法：

Sub Getsheets()
    Dim Path As String, Filename As String, Sheet As Worksheet, wkBook As Workbook
    Path = GetFolder("N:\", "Select an Input Folder") & Application.PathSeparator
    Filename = Dir(Path & "*.xlsm")
    Do While Filename <> ""
        Set wkBook = Workbooks.Open(Filename:=Path & Filename, ReadOnly:=True)
        For Each Sheet In wkBook.Sheets
            Sheet.Copy After:=ThisWorkbook.Sheets(1)
        Next Sheet
        Application.DisplayAlerts = False
        wkBook.Close
        Filename = Dir()
    Loop
End Sub

我在一个包含 5 个 .xlsm 文件的文件夹上进行了测试；效果很好。