J'ai fait une mise à jour d'une base access à l'aide d'un petit programme ci-dessus. Ca marche pas mal sauf que lors je veux remplir un champ avec une valeur Null j'ai ce message d'erreur :
Vous essayé d'affecter la valeur Null à une variable qui n'est pas du type données Variant.


Voici le code du programme de mise à jour :

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
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
 
Sub Maj_Struct(ByVal Dbutilisateur As String, ByVal DBReference As String)
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
'Procédure de maj de structure d'une base par rapport à une base référence
'
'Note:
'Les tableaux deltable et delcolumn sont utilisés pour mémoriser les éléments à supprimer, la suppression directe
'étant impossible étant donné qu'une suppression directe boulverse les indices des tables rendant impossible
'la navigation entre les tables de la base
'La suppression intervient donc après avoir mémorisé tous les élements à supprimer
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
Dim org_connection As New ADODB.Connection
Dim RcOrg As New ADODB.Recordset
Dim orgcat As New ADOX.Catalog
Dim cat As New ADOX.Catalog
Dim myconnection As New ADODB.Connection
Dim myrc As New ADODB.Recordset
Dim mycat As New ADOX.Catalog
Dim cu_items() As String
Dim cu_item As Integer
Dim cu_table As Integer
Dim cu_tables() As String
Dim deltable() As String
Dim delcolumn() As String
Dim nbtable As Integer
Dim nbcolumn As Integer
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim l As Integer
Dim m As Integer
Dim newtable As ADOX.Table
myconnection.Provider = "Microsoft.jet.oledb.4.0"
myconnection.ConnectionString = Dbutilisateur '"c:\stages\patrice\boadataold.mdb"
myconnection.Open()
org_connection.Provider = "Microsoft.jet.oledb.4.0"
org_connection.ConnectionString = DBReference '"c:\stages\patrice\boadataref.mdb"
org_connection.Open()
mycat.ActiveConnection = myconnection
orgcat.ActiveConnection = org_connection
cu_table = 0
nbtable = 0
nbcolumn = 0
For i = 0 To orgcat.tables.count - 1
If orgcat.tables(i).TYPE = "TABLE" Then
' on a trouvé une table dans la base de référence
'recherche de la même table dans la base user
nbcolumn = 0
ReDim Preserve cu_tables(cu_table)
cu_tables(cu_table) = orgcat.tables(i).Name
cu_table = cu_table + 1
k = 0
While k < mycat.tables.count - 1 And mycat.tables(k).Name <> orgcat.tables(i).Name
k = k + 1
End While
cu_item = 0
If mycat.tables(k).Name = orgcat.tables(i).Name Then 'si table trouvée dans base user
'énumération des champs pour ajout
For j = 0 To orgcat.tables(i).Columns.count - 1 'tq kil y a des champs dans base de références
ReDim Preserve cu_items(cu_item)
cu_items(cu_item) = orgcat.Tables(i).Columns(j).Name
cu_item = cu_item + 1
l = 0
While l < mycat.tables(k).Columns.count - 1 And mycat.tables(k).Columns(l).Name <> orgcat.tables(i).Columns(j).Name
l = l + 1
End While
If mycat.tables(k).Columns(l).Name = orgcat.tables(i).Columns(j).Name Then 'si champ trouvé
'rien pour l'instant (possibilité peut-être de modification de champ)
Else
'si pas trouvé : Création du champ dans la table
mycat.Tables(k).Columns.Append(orgcat.Tables(i).Columns(j).Name, orgcat.Tables(i).Columns(j).Type, orgcat.Tables(i).Columns(j).DefinedSize)
End If
Next
 
'suppression des champs dans base user non existant dans base référence
For j = 0 To (mycat.tables(k).Columns.count - 1)
m = 0
While m < cu_item - 1 And cu_items(m) <> mycat.tables(k).Columns(j).Name
m = m + 1
End While
If mycat.tables(k).Columns(j).Name = cu_items(m) Then
'si champ trouvé
Else
ReDim Preserve delcolumn(nbcolumn)
delcolumn(nbcolumn) = mycat.tables(k).Columns(j).Name
nbcolumn = nbcolumn + 1
End If
Next
 
For j = 0 To nbcolumn - 1
m = 0
While m < mycat.tables(k).Columns.count - 1 And mycat.tables(k).Columns(m).Name <> delcolumn(j)
m = m + 1
End While
If mycat.tables(k).Columns(m).Name = delcolumn(j) Then
mycat.tables(k).Columns.Delete(m)
End If
Next
 
Else
'Création de la table
newtable = New ADOX.Table
With newtable
.Name = orgcat.tables(i).Name
With .Columns
For j = 0 To orgcat.tables(i).Columns.count - 1
.Append(orgcat.tables(i).Columns(j).Name, orgcat.tables(i).Columns(j).TYPE, orgcat.tables(i).Columns(j).DefinedSize)
Next
End With
End With
mycat.tables.Append(newtable)
newtable = Nothing
End If
End If
Next
For j = 0 To mycat.tables.count - 1
If mycat.tables(j).TYPE = "TABLE" Then
m = 0
While m < cu_table - 1 And cu_tables(m) <> mycat.tables(j).Name
m = m + 1
End While
If mycat.tables(j).Name = cu_tables(m) Then
'si table trouvée
Else
ReDim Preserve deltable(nbtable)
deltable(nbtable) = mycat.tables(j).Name
nbtable = nbtable + 1
End If
End If
Next
For j = 0 To nbtable - 1
m = 0
While m < mycat.tables.count - 1 And mycat.tables(m).Name <> deltable(j)
m = m + 1
End While
If mycat.tables(m).Name = deltable(j) Then
mycat.tables.Delete(m)
End If
Next
MsgBox("Import structure terminé", vbInformation, "Import réussi")
org_connection.Close()
myconnection.Close()
org_connection = Nothing
myconnection = Nothing
' DoCmd.Close(acForm, "frmmodifstruct", acSaveNo)
End Sub