XL 2010 Vba - Copier data excel vers Acess

[Evictius]

Bonjour à tous,

J'ai récupéré le code de ce post.
Voici le code complet que j'utilise:

Sub tranfertFeuilleClasseursFermes_VersAccess()
Dim Cn As New ADODB.Connection
Dim oProdRS As New ADODB.Recordset, oRS As ADODB.Recordset
Dim oConn As ADODB.Connection
Dim j As Integer
Dim Fichier As String, Repertoire As String
'------------------------------------------------------
'Connection à la Base Access
Set oConn = New ADODB.Connection
oConn.Open "Provider='Microsoft.Jet.OLEDB.4.0';" & _
"Data Source= 'D:\repA\maBase.mdb';"

'les données seront placés dans Table1
Set oRS = New ADODB.Recordset
oRS.Open "Select * from Table1", oConn, adOpenKeyset, adLockOptimistic
'------------------------------------------------------
'Boucle sur les classeurs Excel du répertoire cible
Repertoire = "D:\repB\"
Fichier = Dir(Repertoire & "\*.xlsx")

Do While Fichier <> ""
    'Connection au classeur Excel
    With Cn
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
            & Fichier & ";Extended Properties=""Excel 12.0;HDR=YES;"""
        .Open
    End With
   
    'requête pour extraire les données de la Feuil1
    oProdRS.Open "SELECT * FROM [Feuil1$]", Cn, adOpenStatic
   
    ' --- Transfert des données dans la base ---
    Do While Not (oProdRS.EOF)
        oRS.addNew
            For j = 0 To oRS.Fields.Count - 1
            oRS.Fields(j) = oProdRS.Fields(j).Value
            Next j
        oRS.Update
        oProdRS.moveNext
    Loop
    '-------------------------------------------
   
    oProdRS.Close
    'Fermeture de la connection au classeur Excel
    Cn.Close
Fichier = Dir
Loop

oRS.Close
Set oRS = Nothing
'Fermeture de la connection Access
oConn.Close
Set oConn = Nothing
End Sub

J'ai modifié la connexion pour que le code soit fonctionnel avec Excel 2010 mais je rencontre une erreur d’exécution dans la section transfert des données:

    Do While Not (oProdRS.EOF)
        oRS.addNew
            For j = 0 To oRS.Fields.Count - 1
            oRS.Fields(j) = oProdRS.Fields(j).Value
            Next j
        oRS.Update
        oProdRS.moveNext
    Loop

Une erreur apparaît m'indiquant que le type ne correspond pas.
Quelqu'un saurait m'aider ?

Merci à tous,

Evicitus

 

[Staple1600]

Bonsoir le fil, le forum

@Evictius
Tu as bien fait ce qu'on pouvait lire dans le fil que tu cites?

la procédure nécessite d'activer la référence Microsoft ActiveX Data Objects x.x Library

Si non, tu sais ce qu'il te reste à faire

 

[Evictius]

Hello Staple, oui bien sur. Les 2 références sont bien activées.

 

[Evictius]

J'ai un peu avancé en arrivant au boulot:
Voila le nouveau code que j'utilise:

Sub tranfertFeuilleClasseursFermes_VersAccess_V02()
'Nécessite d'activer la référence Microsoft ActiveX Data Objects x.x Library
'Nécessite d'activer la référence Microsoft ADO ext x.x for DLL and Security
'
Dim Cn As New ADODB.Connection
Dim oProdRS As New ADODB.Recordset, oRS As ADODB.Recordset
Dim oConn As ADODB.Connection
Dim j As Integer
Dim Fichier As String, Repertoire As String, Feuille As String
Dim oCat As ADOX.Catalog

'------------------------------------------------------
'Connection à la Base Access
Set oConn = New ADODB.Connection
oConn.Open "Provider='Microsoft.Jet.OLEDB.4.0';" & _
"Data Source= 'D:\repA\maBase.mdb';"

'les données seront placés dans Table1
Set oRS = New ADODB.Recordset
oRS.Open "Select * from Table1", oConn, adOpenKeyset, adLockOptimistic
'------------------------------------------------------
'Boucle sur les classeurs Excel du répertoire cible
Repertoire = "D:\repB\"
Fichier = Dir(Repertoire & "\*.xlsx")


    With Cn
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
        & Fichier & ";Extended Properties=""Excel 12.0;HDR=YES;"""
    .Open
Do While Fichier <> ""
    'Connection au classeur Excel
    '-------------------------
    Set oCat = New ADOX.Catalog
    Set oCat.ActiveConnection = Cn
    'Récupére le nom de la Feuille:
       'Attention: l'index correspond à un ordre alphabétique croissant
       'et les plages de cellules nommées sont intégrées.
    Feuille = oCat.Tables(0).Name
    '-------------------------
   
   
    'requête pour extraire les données de la Feuil1
    oProdRS.Open "SELECT * FROM [" & Feuille & "]", Cn, adOpenStatic
   
    ' --- Transfert les données dans la base ---
    Do While Not (oProdRS.EOF)
        oRS.addNew
            For j = 0 To oRS.Fields.Count - 1
            oRS.Fields(j) = oProdRS.Fields(j).Value
            Next j
        oRS.Update
        oProdRS.moveNext
    Loop
    '-------------------------------------------
   
   
    Set oCat = Nothing
    oProdRS.Close
    'Fermeture de la connection au classeur Excel
    Cn.Close
Fichier = Dir
Loop
End With
oRS.Close
Set oRS = Nothing
'Fermeture de la connection Access
oConn.Close
Set oConn = Nothing
End Sub

J'ai une erreur d'execution sur :

    Feuille = oCat.Tables(0).Name

"Impossible de trouver l'objet dans la collection correspondant ua nom ou à la référence ordinale demandé"