Import excel dans access

Résolu
Srah -  
f894009 Messages postés 17414 Date d'inscription   Statut Membre Dernière intervention   -
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,
A voir également:

4 réponses

Réponse 1 / 4
michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   3 318
 
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
0
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.
0
Réponse 2 / 4
f894009 Messages postés 17414 Date d'inscription   Statut Membre Dernière intervention   1 715
 
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
0
Réponse 3 / 4
Sarah_Ber Messages postés 5 Statut Membre
 
Merci f894009!
J'ai eu cette erreur en fin d'exécution due à l'utilisation de "MoveNext".


0
f894009 Messages postés 17414 Date d'inscription   Statut Membre Dernière intervention   1 715
 
Re,

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

montrez le code en entier svp!!!!!!!!!!!!!
0
Utilisateur anonyme > f894009 Messages postés 17414 Date d'inscription   Statut Membre Dernière intervention  
 
Bonjour à 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.  😊
 
0
Réponse 4 / 4
Sarah_Ber Messages postés 5 Statut Membre
 
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
0
f894009 Messages postés 17414 Date d'inscription   Statut Membre Dernière intervention   1 715
 
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+
0
Utilisateur anonyme > f894009 Messages postés 17414 Date d'inscription   Statut Membre Dernière intervention  
 
Bonjour f894009, je te laisse lire mon message 8
Cordialement.  😉
0
f894009 Messages postés 17414 Date d'inscription   Statut Membre Dernière intervention   1 715 > Utilisateur anonyme
 
Bonjour,

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
0
Sarah_Ber Messages postés 5 Statut Membre
 
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 :)
0