自动将文件夹（现有和待添加）中的所有 Excel 数据导入 Microsoft Access答案

【问题标题】：Automatically import all excel data in a folder (existing and to be added) to Microsoft Access自动将文件夹（现有和待添加）中的所有 Excel 数据导入 Microsoft Access
【发布时间】：2021-05-15 07:05:08
【问题描述】：

我有一个包含一系列 excel 文件的文件夹，所有这些文件都有一个名为“summary”的工作表，其中包括一行 4 列（所有 excel 文件中的列数和标题完全相同）。我想在 Access 中创建一个数据库，该数据库在单个表中导入所有现有文件的工作表“摘要”信息（将每个 Excel 工作表的信息附加到一行中）。稍后，当我向该文件夹添加一个新的 excel 文件时，我希望它的数据自动添加到 Access 数据库中，而无需进一步努力。这甚至可以使用 Access 吗？

我可以使用 excel（从文件夹获取数据）来做到这一点，但是当一个新文件添加到文件夹时更新数据库需要很长时间。

提前感谢您的回答！

【问题讨论】：

标签： excel vba ms-access import

【解决方案1】：

您可以使用一些VBA循环保存文件的文件夹，检查文件是否已经导入，如果没有打开文件并从相关单元格中获取数据。在 Access 的表中，您需要有一个字段来存储文件名，以便将来的迭代知道该文件已被导入。一些 VBA 代码可以帮助您入门：

Sub sGetExcelDataFromFolder()
    On Error GoTo E_Handle
    Dim objXL As New Excel.Application
    Dim objXLBook As Excel.Workbook
    Dim objXLSheet As Excel.Worksheet
    Dim db As DAO.Database
    Dim rsData As DAO.Recordset
    Dim strFolder As String
    Dim strFile As String
    strFolder = "C:\test\data\"
    Set db = CurrentDb
    Set rsData = db.OpenRecordset("SELECT * FROM tblExcelData WHERE 1=2;")
    strFile = Dir(strFolder)
    Do
        If Right(strFile, 5) = ".xlsx" Then
            Debug.Print strFile
            If IsNull(DLookup("FileName", "tblExcelData", "FileName='" & strFile & "'")) Then   '   file has not already been imported
                Set objXLBook = objXL.Workbooks.Open(strFolder & strFile)
                Set objXLSheet = objXLBook.Worksheets("Summary")
                With rsData
                    .AddNew
                    !FileName = strFile
                    !F1 = objXLSheet.Cells(1, 1)
                    !F2 = objXLSheet.Cells(1, 2)
                    !F3 = objXLSheet.Cells(1, 3)
                    !F4 = objXLSheet.Cells(1, 4)
                    .Update
                End With
                Set objXLSheet = Nothing
                objXLBook.Close SaveChanges:=False
                Set objXLBook = Nothing
            End If
        End If
        strFile = Dir
    Loop Until strFile = ""
sExit:
    On Error Resume Next
    Set objXLSheet = Nothing
    objXLBook.Close
    Set objXLBook = Nothing
    objXL.Quit
    Set objXL = Nothing
    rsData.Close
    Set rsData = Nothing
    Set db = Nothing
    Exit Sub
E_Handle:
    MsgBox "sGetExcelDataFromFolder", vbOKOnly + vbCritical, "Error: " & Err.Number
    Resume sExit
End Sub

您可以在单击命令按钮时运行此代码（以便用户可以确定何时重新运行代码），或者您可以使用数据库中的启动表单在打开数据库时运行此代码.

随着更多文件添加到此文件夹，您可能需要考虑使用 VBA 将处理后的文件移动到另一个文件夹，这样代码就不必检查 100 多个文件来查找要导入的新文件。

问候，

【讨论】：