使用 Excel VBA 将数据导出到 MS Access 表 [英] Using Excel VBA to export data to MS Access table
问题描述
我目前正在使用以下代码将数据从工作表导出到 MS Access 数据库,代码循环遍历每一行并将数据插入到 MS Access 表中.
I am currently using following code to export data from worksheet to MS Access database, the code is looping through each row and insert data to MS Access Table.
Public Sub TransData()
Application.ScreenUpdating = False
Application.EnableAnimations = False
Application.EnableEvents = False
Application.DisplayAlerts = False
ActiveWorkbook.Worksheets("Folio_Data_original").Activate
Call MakeConnection("fdMasterTemp")
For i = 1 To rcount - 1
rs.AddNew
rs.Fields("fdName") = Cells(i + 1, 1).Value
rs.Fields("fdDate") = Cells(i + 1, 2).Value
rs.Update
Next i
Call CloseConnection
Application.ScreenUpdating = True
Application.EnableAnimations = True
Application.EnableEvents = True
Application.DisplayAlerts = True
End Sub
<小时>
Public Function MakeConnection(TableName As String) As Boolean
'*********Routine to establish connection with database
Dim DBFullName As String
Dim cs As String
DBFullName = Application.ActiveWorkbook.Path & "FDData.mdb"
cs = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & DBFullName & ";"
Set cn = CreateObject("ADODB.Connection")
If Not (cn.State = adStateOpen) Then
cn.Open cs
End If
Set rs = CreateObject("ADODB.Recordset")
If Not (rs.State = adStateOpen) Then
rs.Open TableName, cn, adOpenKeyset, adLockOptimistic
End If
End Function
<小时>
Public Function CloseConnection() As Boolean
'*********Routine to close connection with database
On Error Resume Next
If Not rs Is Nothing Then
rs.Close
End If
If Not cn Is Nothing Then
cn.Close
End If
CloseConnection = True
Exit Function
End Function
以上代码适用于几百行记录,但显然要导出更多数据,比如 25000 条记录,是否可以在不循环遍历所有记录的情况下导出,并且只需一个 SQL INSERT 语句将所有数据批量插入到一次性访问表女士?
Above code works fine for few hundred lines of records, but apparently it will be more data to export, Like 25000 records, is it possible to export without looping through all records and just one SQL INSERT statement to bulk insert all data to Ms.Access Table in one go?
任何帮助将不胜感激.
问题已解决
仅供参考,如果有人寻求此信息,我已经进行了大量搜索,发现以下代码对我来说很好用,而且由于 SQL INSERT,速度非常快(仅 3 秒内就有 27648 条记录!!!!):
Just for information if anybody seeks for this, I've done a lots of search and found the following code to be work fine for me, and it is real fast due to SQL INSERT, (27648 records in just 3 seconds!!!!):
Public Sub DoTrans()
Set cn = CreateObject("ADODB.Connection")
dbPath = Application.ActiveWorkbook.Path & "FDData.mdb"
dbWb = Application.ActiveWorkbook.FullName
dbWs = Application.ActiveSheet.Name
scn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbPath
dsh = "[" & Application.ActiveSheet.Name & "$]"
cn.Open scn
ssql = "INSERT INTO fdFolio ([fdName], [fdOne], [fdTwo]) "
ssql = ssql & "SELECT * FROM [Excel 8.0;HDR=YES;DATABASE=" & dbWb & "]." & dsh
cn.Execute ssql
End Sub
仍在努力添加特定字段名称而不是使用Select *",尝试了各种添加字段名称的方法,但目前无法使其正常工作.
Still working to add specific fields name instead of using "Select *", tried various ways to add field names but can't make it work for now.
推荐答案
是否可以在不遍历所有记录的情况下导出
is it possible to export without looping through all records
对于 Excel 中包含大量行的区域,如果您在 Excel 中创建一个 Access.Application
对象,然后使用它导入,您可能会看到一些性能改进将 Excel 数据导入 Access.下面的代码在包含以下测试数据的同一个 Excel 文档中的 VBA 模块中
For a range in Excel with a large number of rows you may see some performance improvement if you create an Access.Application
object in Excel and then use it to import the Excel data into Access. The code below is in a VBA module in the same Excel document that contains the following test data
Option Explicit
Sub AccImport()
Dim acc As New Access.Application
acc.OpenCurrentDatabase "C:UsersPublicDatabase1.accdb"
acc.DoCmd.TransferSpreadsheet _
TransferType:=acImport, _
SpreadSheetType:=acSpreadsheetTypeExcel12Xml, _
TableName:="tblExcelImport", _
Filename:=Application.ActiveWorkbook.FullName, _
HasFieldNames:=True, _
Range:="Folio_Data_original$A1:B10"
acc.CloseCurrentDatabase
acc.Quit
Set acc = Nothing
End Sub
这篇关于使用 Excel VBA 将数据导出到 MS Access 表的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!