Import excel dans access

Résolu
Srah -  
Bonjour,

Je cherche à mettre mon code vba Excel sous access mais j' y arrive pas! Je vous explique: Il s'agit d'un code qui fait de l' import des colonnes excel dans une table access, sauf que le code je le mettais sous excel; maintenant, Je souhaite mettre le code sous access, comme ça je peux faire cet import à partir de n'importe quel fichier excel vers ma base access. 

 Sub ADOFromExcelToAccess()
 Dim cn As ADODB.Connection, rs As ADODB.Recordset, r As Long
 Chemin = ActiveWorkbook.Path
 Set db = OpenDatabase("chemin database.mdb")
 Source = Chemin & "\database name"
 Set cn = New ADODB.Connection
 cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source= " & Source & ";"

 ' open a recordset
 Set rs = New ADODB.Recordset
 rs.Open "[MA TABLE ACCESS]", cn, adOpenKeyset, adLockOptimistic, adCmdTable ' all records in a table

 r = 2 ' the start row in the worksheet
 Do While Len(Range("A" & r).Formula) > 0 ' repeat until first empty cell in column A
 
With rs
 .AddNew ' create a new record
 ' add values to each field in the record
 .Fields("COL1") = Range("A" & r).Value
 .Fields("COL2") = Range("B" & r).Value

 .Update ' stores the new record
 End With
 r = r + 1 ' next row
 Loop
 rs.Close
 Set rs = Nothing
 cn.Close
 Set cn = Nothing
 End Sub


Merci d'avance,

4 réponses

  1. Sarah_Ber
    Voici mon code en entier. 

    Sub DataExcel_Access()
    Dim Rsxl As ADODB.Recordset, r As Long
    Dim rs As Recordset
    Dim cnxl As ADODB.Connection
    Dim Cd As ADODB.Command
    
    Set db = CurrentDb
    ' open a recordset: nom de table a adapter
    SQL = "Select * From [EXTRACTED_RECORDS]"
    Set rs = CurrentDb.OpenRecordset(SQL)
    'a adapter
    Fichier = "C:\Users\Desktop\BD\EXTRACT_XLTOACCESS.xlsm"
    
    Set cnxl = New ADODB.Connection
    Set Cd = New ADODB.Command
    Set Rsxl = New ADODB.Recordset
    With cnxl
        .ConnectionString = "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};DBQ=" & Fichier & ";ReadOnly=0;HDR=YES"
        .Open
    End With
    Cd.ActiveConnection = cnxl
    'mettre le nom de le feuille et les colonnes a selectionner
    Cd.CommandText = " SELECT * FROM [Results$A:L]"
    'creation recordset feuille excel
    Rsxl.Open Cd, , adOpenKeyset, adLockOptimistic
    'boucle sur le recordset
    Do While Not Rsxl.EOF
        With rs
            .AddNew ' create a new record
            ' add values to each field in the record
            .Fields(0) = Rsxl(0)        
            .Fields(1) = Rsxl(1)        
            .Fields(2) = Rsxl(2)        
            .Fields(3) = Rsxl(3)        
            .Fields(4) = Rsxl(4)       
            .Fields(5) = Rsxl(5)        
            .Fields(6) = Rsxl(6)        
            .Fields(7) = Rsxl(7)        
            .Fields(8) = Rsxl(8)        
            .Fields(9) = Rsxl(9)        
            .Fields(10) = Rsxl(10)        
            .Fields(11) = Rsxl(11)        
            .Update ' stores the new record
        End With
        Rsxl.MoveNext
    Loop
    
    MsgBox "Ajout termine"
    
    rs.Close
    1.  f894009
      Re,

      En effet y un lezard, je regarde car en modifiant un fichier excel, j'ai la meme erreur que vous

      Vous pourriez mettre un fichier excel a dispo en modifiant les donnees sensibles

      A+
    3. Sarah_Ber
      Merci infiniment f894009 et albkan!!
      j'ai basculé vers un autre code à base de SQL avec peu de lignes et qui marche super bien. 

      cSQL = "INSERT INTO [IMPORT_ExcelToAccess] ([ID_country], [Name_Country], [Result]  ) SELECT [Id_pays], [Nom_pays],[Resultat] FROM  [Resultats$] in 'c:\MyRepertoire\MyFichier.xlsx' 'excel 8.0;HDR=Yes;IMEX=1;' ;"
CurrentDb.Execute cSQL


      Bon week end :)
    4. f894009
      @Utilisateur anonymeBonjour,

      Ai trouvez. J'utilise ce code pour du VBA Excel avec les references qu'il faut ajouter (ADO,DAO). Dans du VBA Access, il faut aussi ajouter des references ADO meme en ayant cocher office xx.x object library qui normalement suffit pour programmer
  2. Sarah_Ber
    Merci f894009!
    J'ai eu cette erreur en fin d'exécution due à l'utilisation de "MoveNext".

    1. f894009
      Re,

      chez moi, j'utilise ce code dans differente base access et ca marche

      montrez le code en entier svp!!!!!!!!!!!!!
    2. Utilisateur anonyme
      @f894009Bonjour à Sarah_Ber et f894009,

      Je pense que le code VBA est bon et n'a besoin d'aucune modification !

      Le message d'erreur survient car au moins une donnée qui doit être
      enregistrée dans une table ou liste Access est incorrecte par rapport
      aux règles de la table ou liste Access correspondante (longueur,
      type, ou autre...).

      ----------------------------------------------------

      Sans être très bon en anglais, voici quand même la traduction
      du message d'erreur :

      «
      Vous ne pouvez pas enregistrer vos modifications parce qu'une des valeurs
      que vous avez saisies ne respecte pas les paramètres définis pour cette
      table ou cette liste (par exemple, une valeur est inférieure au minimum,
      ou supérieure au maximum). Corrigez l'erreur et réessayez.
      »

      ----------------------------------------------------

      Ensuite, tout le problème est de trouver la ou les valeur(s) en cause,
      et pour quelle(s) table(s) ou liste(s) ! Bonne chance !

      Cordialement.  😊
       
  3. f894009
    Bonjour tout le monde,

    maintenant, Je souhaite mettre le code sous access

    code VBA Access:
    Recuparation donnees feuille excel et ecriture dans table Access

    une facon de faire: 

    Sub DataExcel_Access()
    Dim Rsxl As ADODB.Recordset, r As Long
    Dim rs As Recordset
    Dim cnxl As ADODB.Connection
    Dim Cd As ADODB.Command
    
    Set db = CurrentDb
    ' open a recordset: nom de table a adapter
    SQL = "Select * From [Migration Geotec_1- Côte Nord]"
    Set rs = CurrentDb.OpenRecordset(SQL)
    'a adapter
    Fichier = "D:\_Docs_Prog_Excel\ADODB_excel\fichier_test1.xlsx"
    
    Set cnxl = New ADODB.Connection
    Set Cd = New ADODB.Command
    Set Rsxl = New ADODB.Recordset
    With cnxl
        .ConnectionString = "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};DBQ=" & Fichier & ";ReadOnly=0;HDR=YES"
        .Open
    End With
    Cd.ActiveConnection = cnxl
    'mettre le nom de le feuille et les colonnes a selectionner
    Cd.CommandText = " SELECT * FROM [fichier_test$A:B]"
    'creation recordset feuille excel
    Rsxl.Open Cd, , adOpenKeyset, adLockOptimistic
    'boucle sur le recordset
    Do While Not Rsxl.EOF
        With rs
            .AddNew ' create a new record
            ' add values to each field in the record
            .Fields(0) = Rsxl(0)        'nom de champ ou numero a adapter
            .Fields(1) = Rsxl(1)        'nom de champ ou numero a adapter
            .Update ' stores the new record
        End With
        Rsxl.MoveNext
    Loop
    
    MsgBox "Ajout termine"
    
    rs.Close
    Set rs = Nothing
    cnxl.Close
    Set cnxl = Nothing
    Set Cd = Nothing
    Set Rsxl = Nothing
End Sub
    1. michel_m Contributeur
      Bonjour
      normalement pour inscrire un nouvel enregistrement dans une database on utilise une requete avec la syntaxe "insert to" de SQL
      ci dessous un exemple d'archivage de facture d'une feuille Excel (XL<2007)
      vers la table T_archives de suivi_affaires.mdb 
      Sub archiver_Access()
      Dim conn As Object
      Dim requete As Object
      Dim f_num As Long, f_date As Date, c_num As String, e_date As Date, totalHT As Double
      Dim base_ac As String, fichier As String, texte_SQL As String

      '---------collecte les infos de la facture
      f_num = Range("A14")
      f_date = Range("A16")
      c_num = CStr(Range("C16"))
      e_date = Range("H16")
      totalHT = Range("F43")

      '-------connexion à la base dans fichier archives.xls
      base_ac = "Suivi_affaire.mdb" 'a adapter
      fichier = ThisWorkbook.Path & "\" & base_ac 'a adapter
      Set conn = CreateObject("ADODB.Connection")
      conn.Open "Provider = Microsoft.Jet.OLEDB.4.0;" & _
                      "data source=" & fichier & ";"
                      
      '----------- travail demandé: insère dans les champs de "T_archive les données collectées
      texte_SQL = "INSERT INTO T_archive (num_fact,dat_fact,num_comm,echeance,montant_HT) VALUES ('" & (f_num) & "','" & (f_date) & "', '" & (c_num) & "','" & (e_date) & "', '" & (totalHT) & "')"
      ' éxécute le travail demandé
      Set requete = CreateObject("ADODB.recordset")
      On Error GoTo alerte 'cas où la facture (numéro) a déjà été enregistrée
      Set requete = conn.Execute(texte_SQL)

      '---------------déroulement normal
      MsgBox "archivage de la facture n° " & f_num & " effectué avec succès"
      Set requete = Nothing
      Set conn = Nothing
      Exit Sub

      '------------- gestionnaire erreurs
      ' facture déjà enregistrée
      alerte:
      MsgBox "la facture n° " & f_num & " a déjà été enregistrée!", vbCritical
      Set requete = Nothing
      Set conn = Nothing
      End Sub


      Si les fichiers de ce code xl-access t'intéressent, fais signe

       Michel
      1. Srah
        Merci de votre réponse!
        Mon problème c'est que ce code est à mettre sous Excel, moi je veux adapter votre code ou le mien avec access, c'est à dire mettre ce code sous access et non pas excel ,pour qu'il soit valable pour tout autre import d'Excel vers access.
        Merci Michel.

    Discussions similaires

    Quick Access service
    alain_1949

    4 réponses
    Acer quick access
    Bidou21

    2 réponses