SQL 使用 Excel VBA 将数据导出到 MS Access 表

Using Excel VBA to export data to MS Access table

提问by Ahmed

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.

我目前正在使用以下代码将数据从工作表导出到 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 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

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?

上面的代码适用于几百行记录，但显然要导出更多的数据，比如 25000 条记录，是否可以在不循环遍历所有记录的情况下导出，只需一个 SQL INSERT 语句将所有数据批量插入 Ms.Access一张桌子？

Any help will be much appreciated.

任何帮助都感激不尽。

EDIT: ISSUE RESOLVED

编辑：问题已解决

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!!!!):

仅供参考，如果有人寻求此信息，我已经进行了大量搜索，发现以下代码对我来说很好用，而且由于 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

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.

仍在努力添加特定字段名称而不是使用“选择 *”，尝试了各种方法来添加字段名称，但目前无法使其工作。

采纳答案by Gord Thompson

is it possible to export without looping through all records

是否可以在不遍历所有记录的情况下导出

For a range in Excel with a large number of rows you may see some performance improvement if you create an Access.Applicationobject in Excel and then use it to importthe Excel data into Access. The code below is in a VBA module in the same Excel document that contains the following test data

对于有大量行的范围在Excel中，你可能会看到一些性能改进，如果你创建一个Access.Application在Excel对象，然后用它来导入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 Sub

回答by manofone

@Ahmed

@艾哈迈德

Below is code that specifies fields from a named range for insertion into MS Access. The nice thing about this code is that you can name your fields in Excel whatever the hell you want (If you use * then the fields have to match exactly between Excel and Access) as you can see I have named an Excel column "Haha" even though the Access column is called "dte".

下面是指定命名范围中的字段以插入 MS Access 的代码。这段代码的好处是，您可以随意命名 Excel 中的字段（如果您使用 *，则字段必须在 Excel 和 Access 之间完全匹配），如您所见，我将 Excel 列命名为“哈哈”即使访问列称为“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