excel - 自动将文件夹(现有和待添加)中的所有 Excel 数据导入 Microsoft Access
问题描述
我有一个包含一系列 excel 文件的文件夹,所有这些文件都有一个名为“summary”的工作表,其中包括一行 4 列(所有 excel 文件中的列数和标题完全相同)。我想在 Access 中创建一个数据库,该数据库在单个表中导入所有现有文件的工作表“摘要”信息(将每个 Excel 工作表的信息附加到一行中)。稍后,当我向该文件夹添加一个新的 excel 文件时,我希望它的数据自动添加到 Access 数据库中,而无需进一步努力。这甚至可以使用 Access 吗?
我可以使用 excel(从文件夹获取数据)来做到这一点,但是当将新文件添加到文件夹时,更新数据库需要很长时间。
提前感谢您的回答!
解决方案
您可以使用一些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 多个文件来查找要导入的新文件。
问候,
推荐阅读
- jenkins - 为什么这个 Jenkins 构建脚本会两次分配相同的节点 ID?
- lambda - @FunctionalInterface 只是一个标记接口还是更多?
- jira - 编辑活动工作流程的限制/缺点?
- applescript - 如何将 AppleScript URL 对象转换为文本
- azure - Azure AD 设置为 Lambda 授权者混淆 - 所有基于服务器
- python - python3.9 vs.python3.6中的timedelta问题
- python - Python PyTesseract 模块从图像中返回乱码
- reactjs - 如果用户在搜索栏中输入不正确的查询格式,则反应句柄错误
- r - 添加空列以获得一定数量的列到现有数据框
- docker-compose - NAS Synology docker-compose 未找到