执行Excel宏，然后在一个文件夹中的多个Excel文件上导入Access表

Question

我需要将多个 Excel 电子表格导入到 Access 表中。 电子表格目前看起来像这样：

ID | Year | Sales | Commissions
-- | ---- | ----- | -----------
 1 | 2016 | 1,000 |  100
 2 | 2016 | 2,000 |  200
 3 | 2016 | 3,000 |  300
 4 | 2016 | 1,000 |  300

他们需要看起来像这样：

ID | Name | Year | Month | Sales | Commissions | Discount | Net Sales | %
-- | ---- | ---- | ----- | ----- | ----------- | -------- | --------- | -
 1 | John | 2016 |  2    | 1,000 |  100        |          |           |
 2 | Mary | 2016 |  2    | 2,000 |  200        |          |           |
 3 | Jake | 2016 |  2    | 3,000 |  300        |          |           |
 4 | Bob  | 2016 |  2    | 1,000 |  300        |          |           |

最后三列将为空白。 姓名（“John、Mary...”）将根据另一个电子表格中的 ID 进行查找，但这可以稍后在 Access 中完成。 顶部的 3 行也必须删除。 月份（“2”）将位于 Excel 文件的文件路径中。 它将是文件名中唯一的数字。 即，“2”代表二月。 所有电子表格都将位于同一文件夹中。 每个 Excel 工作簿都有一个标题为“DataSheet”的电子表格。 这是将从每个工作簿导入的电子表格。

我可以在 Access 中编写一个脚本来完成所有这些吗？

到目前为止，我已经为 Excel 宏提供了这个：

  Sub Macro2()
    Rows("1:3").Select
    Range("A3").Activate
    Selection.Delete Shift:=xlUp
    Columns("B:B").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "Name"
    Columns("D:D").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "Month"
    Range("G1").Select
    ActiveCell.FormulaR1C1 = "Discount"
    Range("H1").Select
    ActiveCell.FormulaR1C1 = "Net Sales"
    Range("I1").Select
    ActiveCell.FormulaR1C1 = " %"
    Range("G2").Select
End Sub

这里的东西一样，这将导入多个文件：

    Dim strPathFile As String, strFile As String, strPath As String
    Dim strTable As String
    Dim blnHasFieldNames As Boolean
    blnHasFieldNames = False
    strTable = "tablename"
    strFile = Dir(strPath & "*.xls")
    Do While Len(strFile) > 0
          strPathFile = strPath & strFile
          DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
                strTable, strPathFile, blnHasFieldNames
          strFile = Dir()
    Loop

Answer 1

对我来说，这看起来像是一些简单的 vlookups。 一旦你理顺了 excel 的东西，并且你准备好将多个文件导入到一个表中，只需运行一个这样的脚本。

Sub ImportAllFilesIntoOneTable

        Dim strPathFile As String, strFile As String, strPath As String
        Dim strTable As String
        Dim blnHasFieldNames As Boolean

        ' Change this next line to True if the first row in EXCEL worksheet
        ' has field names
        blnHasFieldNames = False

        ' Replace C:\Documents\ with the real path to the folder that
        ' contains the EXCEL files
        strPath = "C:\Documents\"

        ' Replace tablename with the real name of the table into which
        ' the data are to be imported
        strTable = "tablename"

        strFile = Dir(strPath & "*.xls")
        Do While Len(strFile) > 0
              strPathFile = strPath & strFile
              DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
                    strTable, strPathFile, blnHasFieldNames

        ' Uncomment out the next code step if you want to delete the
        ' EXCEL file after it's been imported
        '       Kill strPathFile

              strFile = Dir()
        Loop

End Sub