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 |
Partager