Discussion :

[Bougla972]

Bonjour le forum, le fil,

J'ai lu cette discussion.

Je souhaite remplir une table Access à partir d'une plage, le tout en Late Biding.

Lorsque j'exécute la procédure, j'ai un message d'erreur sur la ligne "Add.New"
"3251 Le jeu d'enregistrements suivant ne prend pas en charge la mise à jour. Il s'agit peut-être d'une limitation du fournisseur ou du type de verrou sélectionné."

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
Sub PasteData_LateBiding()
Dim Cat As Object
'Dim Cat As New ADOX.Catalog
Dim Cnx As Object
'Dim Cnx As New ADODB.Connection
Dim rsT As Object
'Dim rsT As New ADODB.Recordset
Dim ndf As String
Dim stSQL As String
'Dim wbPath As String
Dim Derlig As Integer
Dim SDerCol As String
Dim Let_Col As String
Dim oTables As String
Dim L As Long, C As Byte
Dim TabPlage As Variant
Dim DerCol As Byte
Dim Tbl As Object
Dim Requete As String
Dim champ As Object
'Set Cat = CreateObject("ADOX.Catalog")
'Cat.Create "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ndf
 
On Error GoTo ErrHandl
 
ndf = ThisWorkbook.Path & "\" & BDD
'wbPath = ThisWorkbook.FullName
 
Set Ws = ThisWorkbook.Sheets("Donnees")
'Plage Collaborateurs
With Ws
    DerCol = .Range("A1").End(xlToRight).Column
    Derlig = .Range("A65536").End(xlUp).Row
    SDerCol = .Range("A1").End(xlToRight).Address: Let_Col = Mid(SDerCol, 2, InStr(2, SDerCol, "$") - 2)
    TabPlage = .Range("A1:" & Let_Col & Derlig).Value
End With
oTables = "Collaborateurs"
 
'Set Cat = CreateObject("ADOX.Catalog")
 
Set Cnx = CreateObject("ADODB.Connection")
With Cnx
    '.Provider = "Microsoft.JET.OLEDB.4.0"
    .Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ndf & ";Persist Security Info=False;" '"DRIVER={Microsoft Access Driver (*.mdb, *.accdb)}; DBQ=" & ndf
    '.Open ndf
End With
 
'With Cat
'    .ActiveConnection = Cnx
''On Error Resume Next
''    .Tables.Delete COLLABORATEURS
''On Error GoTo 0
'End With
 
'Set Tbl = CreateObject("ADOX.Table")
'Tbl.Name = oTables
Set rsT = CreateObject("ADODB.Recordset")
'Cnx.Execute stSQL
 
'Cat.Tables.Append Tbl
 
With rsT
    .ActiveConnection = Cnx
    '.Open oTables, adOpenKeyset, adLockOptimistic, adCmdTableDirect ', LockType:=adLockOptimistic
    '.Open "Collaborateurs", Cnx, adOpenKeyset ', LockType:=adLockOptimistic
    .Open "Collaborateurs", Cnx ', adOpenKeyset, adLockOptimistic, adCmdTable
End With
 
'supprime l'enregistrement si le champ 'Ville' est vide
Requete = "DELETE * FROM " & "Collaborateurs" '& " WHERE [Ville]IS NULL "
Cnx.Execute Requete
 
'Boucle sur les lignes et colonnes de la plage pour remplir table
'j = 0
For L = 2 To UBound(TabPlage)
'' Parcourir chaque champ de l'enregistrement courant
'   For Each champ In rsT.Fields
'        champ = Ws.Cells(L, 1 + j)
'        j = j + 1
'   Next champ
    With rsT
        .AddNew
        For C = 1 To DerCol
            .Fields(C - 1).Value = TabPlage(L, C)
        Next
    .Update
    End With
Next L
'*******************************************************************
 
Set Cat = Nothing
Set Cnx = Nothing
Set rsT = Nothing
Set Ws = Nothing
Exit Sub
 
ErrHandl:
 
MsgBox Err.Number & vbCr & Err.Description, vbCritical
rep = Err.Number & vbCr & Err.Description
Ws.Range("J11") = rep
'If Not rsT Is Nothing Then
'    If rsT.State = adStateOpen Then rsT.Close
'End If
Set rsT = Nothing
 
If Not Cnx Is Nothing Then
    If Cnx.State = adStateOpen Then Cnx.Close
End If
Set Cnx = Nothing
 
Set Cat = Nothing
'Set Cnx = Nothing
'Set rsT = Nothing
Set Ws = Nothing
 
 
End Sub

Merci d'avance pour votre aide !

Bougla