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

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

我可以在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

像这样的{p> Here's something会导入多个文件：

    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

执行Excel宏，然后导入到文件夹中的多个Excel文件的访问表

1 个答案: