Mise à jour structure base access avec adox
Soyez le premier à donner votre avis sur cette source.
Snippet vu 11 620 fois - Téléchargée 42 fois
Contenu du snippet
Cette procédure permet de mettre à jour la structure d'une base de donnée en utilisant la structure d'une base référence tout en conservant les données incluses dans la première base. (Si vous coprenez pas, relisez une fois :-) )
Pour cela j'utilise ADOX, cela me permet de créer des tables et de champs et d'en supprimer.
Pour cela j'utilise ADOX, cela me permet de créer des tables et de champs et d'en supprimer.
Source / Exemple :
Private Sub Maj_Struct(Dbutilisateur As String, 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 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
Wend
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
Wend
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
Wend
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
Wend
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
Set 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
Set 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
Wend
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
Wend
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
Set org_connection = Nothing
Set myconnection = Nothing
DoCmd.Close acForm, "frmmodifstruct", acSaveNo
End Sub
A voir également
- Adox access
- Mise a jour du base access en VB.net ✓ - Forum - SQL
- Mise à jour de bases de donées - Codes sources - Visual Basic / VB.NET (Base de Donnees)
- Se connecter à une base Access avec ADOX ✓ - Forum - VB.NET
- Probleme de mise à jour dans base de données ✓ - Forum - VB.NET
- Mise a jour de base de donnée .net ✓ - Forum - Visual Basic
Commentaires
deux petits soucis:
-ne gère pas le type autoincrémentation
-ne gère pas les clé primaire
8/10 car ça m'a tout de même beaucoup aidé
J'ai utilisé votre code source.Ca marche pas mal sauf si je veux laisser des valeurs null dans champ qui a ete mise jour. J'ai un message d'erreur : vous essayez d'affecter la valeur Null à une variable qui n'est pas du type de données Variant.
Ca me gene beaucoup
Auriez vous une solution ?
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.