Soyez le premier à donner votre avis sur cette source.
Snippet vu 11 829 fois - Téléchargée 44 fois
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
10 juin 2010 à 12:18
10 nov. 2008 à 20:14
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é
29 mai 2008 à 17:35
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.