Mise à jour structure base access avec adox

Soyez le premier à donner votre avis sur cette source.

Snippet vu 11 500 fois - Téléchargée 42 fois

Commenter

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.

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

Ajouter un commentaire

Commentaires

Signaler
Soccard
Messages postés
2
Date d'inscription
vendredi 29 décembre 2006
Statut
Membre
Dernière intervention
29 mai 2008
 -
bonjour,

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 ?
Signaler
fundenys
Messages postés
19
Date d'inscription
jeudi 27 novembre 2003
Statut
Membre
Dernière intervention
20 novembre 2011
 -
Trés bon code,
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é
Signaler
cs_hihe
Messages postés
1
Date d'inscription
mardi 26 février 2008
Statut
Membre
Dernière intervention
10 juin 2010
 -
merci
S'inscrire maintenant

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.

Du même auteur (PatriceVB)