Erreur d'exécution '3265'

Question

Bonjour, 

Je bosse sur un projet en VBA. Mon code me génère l'erreur suivante quand je compile pas à pas "Erreur d'exécution '3265' Erreur défini par l'application ou par l'objet" lorsque le curseur arrive à cette ligne "Fields("Magasin") = Range("B" & r).Value". J'ai cherché on me dit que cette erreur signifie "3265 : adErrItemNotFound Aucun élément de la collection ne correspond au nom ou à l'ordinal demandé. Un nom de champ ou de table incorrect a été spécifié." je vérifie dans ma base les noms sont apparemment correct. Quelqu'un pourrait-il m'aider. Voici mon code en entier: 
Sub FromExcelToAccess()
Dim cn As ADODB.Connection, rs As ADODB.Recordset, r As Long
    Chemin = ActiveWorkbook.Path
    Source = Chemin & "\gestion stock.mdb"
    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 "[Etat stock]", 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("Code article") = Range("A" & r).Value
            .Fields("Magasin") = Range("B" & r).Value
            .Fields("Emplacement") = Range("C" & r).Value
            .Fields("Ref GE/Origine") = Range("D" & r).Value
            .Fields("Libelle") = Range("E" & r).Value
            .Fields("Qté en stock") = Range("F" & r).Value
            .Fields("Qté mini") = Range("G" & r).Value
            .Fields("Unité de mesure") = Range("H" & r).Value
            .Fields("Coût unitaire moyen") = Range("I" & r).Value
            .Fields("Coût total") = Range("J" & 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

Utilisateur anonyme · Answer

Bonjour,

Ton code est sensiblement bon, mais l'inférence des types
étant ce quel est sous VBA, je te suggère d'être plus explicite
sur les types que tu récupères, le code suivant fonctionne
lorsque tous les champs de la BD sont de type - Texte -.

si :
"Fields("Magasin") = Range("B" & r).Value"

le type

"Fields("Magasin")

pourrait ne pas correspondre avec le type 

Range("B" & r).Value"

Parfois, l'inférence étant ce quel est, le compilateur effectue
mal la promotion/démotion de types, il faut donc être plus explicite.

ex.:

 .Fields("Date du jour").Value = CDate(Range("A" & r).Value)

regarde bien cette relation de type, il y a une erreur !

Voici le code testé sous Excel XP :-)


Option Explicit

Sub FromExcelToAccess()

    Dim cn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim r As Long
    Dim Chemin As String
    Dim Source As String
    
    Chemin = ActiveWorkbook.Path
    Source = Chemin & "\gestion stock.mdb"
    
    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 "[stock]", cn, adOpenKeyset, adLockOptimistic, adCmdTable
    
    Sheets("Donnees").Select
    r = 1
    
    ' all records in a tabler = 2
    ' the start row in the worksheet
    Do While Len(Range("A" & r).Value) > 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("Code article").Value = Range("A" & r).Value
            .Fields("Magasin").Value = Range("B" & r).Value
            .Fields("Emplacement").Value = Range("C" & r).Value
            .Fields("Ref GE/Origine").Value = Range("D" & r).Value
            .Fields("Libelle").Value = Range("E" & r).Value
            .Fields("Qté en stock").Value = Range("F" & r).Value
            .Fields("Qté mini").Value = Range("G" & r).Value
            .Fields("Unité de mesure").Value = Range("H" & r).Value
            .Fields("Coût unitaire moyen").Value = Range("I" & r).Value
            .Fields("Coût total").Value = Range("J" & 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
'


Cdt

Lupin

Erreur d'exécution '3265'

1 réponse

Discussions similaires

Newsletters