Utilisation de Excel VBA pour exporter des données vers la table D'accès MS

j'utilise actuellement le code suivant pour exporter des données à partir de la feuille de travail vers la base de données MS Access, le code est en boucle à travers chaque ligne et insérez des données à la Table 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

code ci-dessus fonctionne très bien pour quelques centaines de lignes d'enregistrements, mais apparemment il sera plus de données à exporter, comme 25000 enregistrements, est-il possible d'exporter sans boucle à travers tous les enregistrements et juste une déclaration SQL INSERT pour insérer toutes les données à la Table D'accès de Mlle en une seule fois?

Toute aide sera très appréciée.

EDIT: ISSUE RESOLVED

Juste pour information, si quelqu'un cherche pour cela, j'ai fait beaucoup de recherche et trouvé le code suivant pour être beau travail pour moi, et c'est rapide en raison de SQL INSERT, (27648 enregistrements en 3 secondes!!!!):

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

Toujours à ajouter des champs spécifiques au lieu d'utiliser "Select *", essayé plusieurs façons d'ajouter des noms de champ mais ne peut pas le faire fonctionner pour l'instant.

19
demandé sur Community 2013-04-23 09:47:09

2 réponses

est-il possible d'exporter sans boucle, à travers tous les enregistrements

pour une plage dans Excel avec un grand nombre de lignes vous pouvez voir une certaine amélioration de performance si vous créez un Access.Application object dans Excel et ensuite l'utiliser pour import les données Excel dans Access. Le code ci-dessous est dans un module VBA dans le même document Excel qui contient les données de test suivantes

SampleData.png

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
17
répondu Gord Thompson 2014-09-10 14:11:13

@Ahmed

ci-dessous est le code qui spécifie les champs d'une plage nommée pour insertion dans MS Access. La bonne chose à propos de ce code est que vous pouvez nommer vos champs dans Excel tout ce que vous voulez (si vous utilisez * alors les champs doivent correspondre exactement entre Excel et Access) comme vous pouvez voir que j'ai nommé une colonne Excel "Haha" même si la colonne Access est appelée "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
0
répondu manofone 2017-10-06 16:35:14