web-dev-qa-db-fra.com

Utilisation d'Excel VBA pour exporter des données vers un tableau MS Access

J'utilise actuellement le code suivant pour exporter des données d'une feuille de calcul vers une base de données MS Access. Le code parcourt chaque ligne et insère des données dans 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

Le code ci-dessus fonctionne bien pour quelques centaines de lignes d’enregistrements, mais il semblerait que ce sera plus de données à exporter. Comme 25 000 enregistrements, il est possible d’exporter sans parcourir en boucle tous les enregistrements et une seule instruction SQL INSERT pour insérer en bloc toutes les données dans Ms.Access Table en une fois?

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

EDIT: PROBLÈME RÉSOLU

Juste pour information si quelqu'un cherche cela, j'ai fait beaucoup de recherches et trouvé que le code suivant fonctionnait bien pour moi, et il est très rapide grâce à SQL INSERT, (27648 enregistrements en 3 secondes seulement !!!! ):

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

Vous travaillez toujours pour ajouter un nom de champ spécifique au lieu d'utiliser "Sélectionner *". Nous avons essayé différentes manières d'ajouter des noms de champ, mais cela ne fonctionnait pas pour le moment.

sqlexcel-vbams-accessaccess-vbavba
19
Ahmed

est-il possible d'exporter sans parcourir tous les enregistrements

Pour une plage dans Excel comportant un grand nombre de lignes, vous constaterez peut-être une amélioration des performances si vous créez un objet Access.Application dans Excel, puis utilisez-le pour importer les données Excel dans Access. Le code ci-dessous se trouve dans un module VBA du 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
18
Gord Thompson

@ Ahmed

Le code ci-dessous spécifie les champs d'une plage nommée à insérer dans MS Access. La bonne chose à propos de ce code est que vous pouvez nommer vos champs dans Excel comme bon vous semble (si vous utilisez *, les champs doivent correspondre exactement entre Excel et Access) car 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
manofone