将相同的Excel文件导入具有多个工作表的访问权限

Question

因此，我正在尝试寻找方法来促进使用Access重新组合Excel工作表中的数据。 我正在尝试做的是，将多个格式完全相同的Excel文件合并到一个连续的表中。 现在，我有一个VBA函数，该函数使我可以跨一个excel文件目录定位一个excel工作表，并将它们组合到一个访问表中。 我的问题是，我该如何做同样的事情，但是对于目录中的每个工作表都是一枪而过，而不是为每个工作表运行和修改代码。

TL; DR您有100个excel文件，每个文件中包含7个工作表。 格式相同，但是数据不同。 如何获取全部100个文件并将其工作表合并到7个相应的MS Access表中？

******问题已解决。 如下工作代码*******

名为SingleModule的模块1：

    Option Compare Database

    Public Function importExcelSheets(Directory As String, TableName As String, WkShtName As String) As Long
    On Error Resume Next
      Dim strDir As String
      Dim strFile As String
      Dim I As Long
      I = 0
      If Left(Directory, 1) <> "\" Then
          strDir = Directory & "\"
      Else
          strDir = Directory
      End If
          strFile = Dir(strDir & "*.XLSX")
      While strFile <> ""
          I = I + 1
          strFile = strDir & strFile
          Debug.Print "importing " & strFile
          DoCmd.TransferSpreadsheet acImport, , TableName, strFile, True, WkShtName
          strFile = Dir()
      Wend
      importExcelSheets = I
    End Function

名为MultipleModule的模块2：

Public Function importMultipleExcelFiles(Directory As String) As Long
For x = 1 To 7
Dim TableName As String
Dim WkShtName As String
    TableName = Choose(x, "Table1", "Table2", "Table3", "Table4")
    WkShtName = Choose(x, "Table1!", "Table2!", "Table3!", "Table4!")
    Call SingleModule.importExcelSheets(Directory, TableName, WkShtName)
Next x
End Function

在立即窗口中使用以下命令来执行（确保更改了文件路径）：

? importMultipleExcelFiles("C:\Excel File Directory")

边注：

您可以在立即窗口的SingleModule上使用以下命令来定位一个工作表：

? importExcelSheets("C:\FilePath", "TableName", "WkShtName!")

Answer 1

抱歉，我没有看到您的TableName如何进入过程。 调用importExcelSheets函数时，将FOR-NEXT与CHOOSE函数一起使用。

for x= 1 to 7
   TableName = choose(x, "Table1", "Table2"...)
   WkShtName = choose(x, "ContactDetails!", ...)
   importExcelSheets  Dir, TableName, WkshtName
next x