使用Excel VBA将数据导出到MS Access表格
使用Excel VBA将数据导出到MS Access表格
提问于 2013-04-23 13:47:10
我目前正在使用以下代码将数据从工作表导出到MS Access数据库，该代码循环通过每行并将数据插入到MS Access表中。
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 SubPublic 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 FunctionPublic 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语句一次性将所有数据批量插入到Ms.Access表的情况下导出？
任何帮助都将不胜感激。
编辑:问题已解决的
作为信息，如果有人在寻找这个，我已经做了很多搜索，发现以下代码对我来说工作得很好，而且由于SQL INSERT，它真的很快(3秒内就有27648条记录！)：
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 *"，尝试了各种方法来添加字段名称，但目前还不能工作。
回答 2
Stack Overflow用户
回答已采纳
发布于 2013-04-23 16:09:33
是否可以在不遍历所有记录的情况下导出
对于包含大量行的区域，如果在Excel中创建一个Access.Application对象，然后使用该对象将Excel数据导入Access，则可能会看到一些性能改进。下面的代码在同一个Excel文档的VBA模块中，该文档包含以下测试数据
Option Explicit
Sub AccImport()
Dim acc As New Access.Application
acc.OpenCurrentDatabase "C:\Users\Public\Database1.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 SubStack Overflow用户
发布于 2017-10-07 00:22:49
@Ahmed
下面的代码指定要插入到MS Access中的命名范围中的字段。这段代码的好处是，您可以在Excel中为字段命名(如果您使用*，则字段必须在Excel和Access之间完全匹配)，正如您可以看到的那样，我已经将Excel列命名为"Haha“，即使Access列被称为"dte”。
Sub test()
dbWb = Application.ActiveWorkbook.FullName
dsh = "[" & Application.ActiveSheet.Name & "$]" & "Data2" 'Data2 is a named range
sdbpath = "C:\Users\myname\Desktop\Database2.mdb"
sCommand = "INSERT INTO [main] ([dte], [test1], [values], [values2]) SELECT [haha],[test1],[values],[values2] FROM [Excel 8.0;HDR=YES;DATABASE=" & dbWb & "]." & dsh
Dim dbCon As New ADODB.Connection
Dim dbCommand As New ADODB.Command
dbCon.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & sdbpath & "; Jet OLEDB:Database Password=;"
dbCommand.ActiveConnection = dbCon
dbCommand.CommandText = sCommand
dbCommand.Execute
dbCon.Close
End Sub页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：
https://stackoverflow.com/questions/16161865
复制相关文章
相似问题