Использование Excel VBA для экспорта данных в таблицу MS Access

Question

В настоящее время я использую следующий код для экспорта данных из рабочего листа в базу данных MS Access, код перебирает каждую строку и вставляет данные в таблицу доступа MS.

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 для массового ввода всех данных в таблицу Ms.Access за один раз?

Любая помощь будет очень признательна.

EDIT: Устранена

Просто для информации, если кто-то ищет для этого, я сделал много поиска и нашел следующий код будет работать нормально для меня, и это очень быстро из-за SQL INSERT, (27648 записей всего за 3 секунды !!!!):

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 *», пробовал различные способы, чтобы добавить имена полей, но не может сделать он работает на данный момент.

Answer 1

is it possible to export without looping through all records

Для диапазона в Excel с большим количеством строк, вы можете увидеть некоторые улучшения производительности при создании Access.Application объекта в Excel, а затем использовать его для импорта данных Excel в Access. Приведенный ниже код в модуле VBA в том же документе Excel, который содержит следующие данные испытаний

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 

Answer 2

@Ahmed

Ниже код, который определяет поля из именованного диапазона для вставки в 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