Comment recuperer code VB de excel 2003 à excel 2007

anthooooony

XLDnaute Occasionnel
Bonjour à tous

j'ai un problème de conversion d'un code VB 2003 à 2007.

En effet, j'ai un code récupéré sur Excel download qui permet de rajouter dans une table access un fichier excel cela dans la version 2003. au préalable je supprime la table et ensuite je lance la macro et ça marchait..



Etant passé sur les deux(access et exce)l au 2007 je rencontre quelques petits désagréments, le problème venant aussi dans le post : dois je le mettre sur excel ou access.. j'essaye Excel..

J'ai le code que j'ai essayé de modifier en premier et le code qui marche pour access 2003 et avec des fichiers d excel 2003 est à la fin.



j'ai modifié oConn.Open "Provider='Microsoft.Jet.OLEDB.4.0';" & _ par oConn.Open "Provider='Microsoft.Jet.OLEDB.12.0';" & _ qui était conseillé dans un autre post.


et ça aussi de 4 à "12" mais en vain, j'ai du me tromper quelque part..
Cn.Open "Provider=Microsoft.Jet.OLEDB.12.0;" & _
"Data Source=" & Repertoire & "\" & Fichier & ";" & _
"Extended Properties=""Excel 12.0;"""



Erreur Dim Cn as New ADODB.Connection
---> Erreur de compilation : Type défini par l'utilisateur non défini..



Code:
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

'-----------------TOP50-------------------------------------
Set oConn = New ADODB.Connection
oConn.Open "Provider='Microsoft.Jet.OLEDB.12.0';" & _
"Data Source= 'C:\Documents and Settings\RC1194\Desktop\test ACCESS 2007\Encaissements clients v1.accdb';"

'les données seront placés dans Table1
Set oRS = New ADODB.Recordset
oRS.Open "Select * from T-Mois", oConn, adOpenKeyset, adLockOptimistic
'------------------------------------------------------
 
'Boucle sur les classeurs Excel du répertoire cible
Repertoire = "C:\Documents and Settings\RC1194\Desktop\test ACCESS 2007\2012"
Fichier = Dir(Repertoire & "\*.xlsx")

Do While Fichier <> ""
    'Connection au classeur Excel
    Cn.Open "Provider=Microsoft.Jet.OLEDB.12.0;" & _
    "Data Source=" & Repertoire & "\" & Fichier & ";" & _
    "Extended Properties=""Excel 12.0;"""
   
    
    '-------------------------
    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 - 2
            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

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










Code:
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

'-----------------TOP50-------------------------------------
Set oConn = New ADODB.Connection
oConn.Open "Provider='Microsoft.Jet.OLEDB.4.0';" & _
"Data Source= 'C:\Documents and Settings\RC1194\Desktop\Test appli\maBase.mdb';"

'les données seront placés dans Table1
Set oRS = New ADODB.Recordset
oRS.Open "Select * from Top50", oConn, adOpenKeyset, adLockOptimistic
'------------------------------------------------------
 
'Boucle sur les classeurs Excel du répertoire cible
Repertoire = "C:\Documents and Settings\RC1194\Desktop\Test appli\sauvegarde\Suivi Top Production 10 derniers jours AC"
Fichier = Dir(Repertoire & "\*.xls")

Do While Fichier <> ""
    'Connection au classeur Excel
    Cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
    "Data Source=" & Repertoire & "\" & Fichier & ";" & _
    "Extended Properties=""Excel 8.0;"""
   
    
    '-------------------------
    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 - 2
            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

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



Merci de votre aide

Anthooooony
 

Discussions similaires

Statistiques des forums

Discussions
312 103
Messages
2 085 314
Membres
102 860
dernier inscrit
fredo67