Ajouter des champs à une table à partir d'une autre base

Ajouter des champs à une table à partir d’une autre base

Article mis en ligne le 17 novembre 2006

dernière modification le 12 décembre 2006

par Patrice MOREL

Access 97

Access 97 | Compatible |

Access 2003

Access 2003 | Non testé |

Par exemple pour créer un patch....

Private Sub BtnPatch_Click()

Dim dbsNorthwind As Database
Dim tdfAvisB As TableDef
Dim tdfAvisN As TableDef
Dim tdfCL As TableDef
Dim tdfNG As TableDef
Dim tdfAccor As TableDef
Dim fldLoop As Field

Set dbsNorthwind = OpenDatabase("C:\VitamineC\Data_Zeste2005.mdb")
Set tdfAvisB = dbsNorthwind.TableDefs!T_Data_AVISBrut_DPX
Set tdfAvisN = dbsNorthwind.TableDefs!T_Data_AVISNet_DPX
Set tdfCL = dbsNorthwind.TableDefs!T_Data_T1VTE_CL_DPX
Set tdfNG = dbsNorthwind.TableDefs!T_Data_T1VTE_NG_DPX
Set tdfAccor = dbsNorthwind.TableDefs!T_Data_T5ACCOR_DPX

'Gestion du message d'erreur n°3191 de Microsoft si le patch a déjà été appliqué (Voir en bas de la procédure)
On Error GoTo Err_BoutonApercuEtat_Click

'-------------------------------------
' Ajoute les nouveaux champs.
AppendDeleteField tdfAvisB, "APPEND", "NumEquipTmp", dbText, 50
AppendDeleteField tdfAvisN, "APPEND", "NumEquipTmp", dbText, 50
AppendDeleteField tdfCL, "APPEND", "NumEquipTmp", dbText, 50
AppendDeleteField tdfNG, "APPEND", "NumEquipTmp", dbText, 50
AppendDeleteField tdfAccor, "APPEND", "NumEquipTmp", dbText, 50


dbsNorthwind.Close

Beep
MsgBox "Patch appliqué", vbInformation, "Merci"
'-------------------------------------

'Gestion du message d'erreur n°3191 de Microsoft si le patch a déjà été appliqué
Exit_BoutonApercuEtat_Click:
Exit Sub

Err_BoutonApercuEtat_Click:
Select Case Err
Case 3191: Beep: MsgBox "Le patch a déjà été appliqué.", 48, "Au revoir ;o)))"
Case Else: MsgBox Error$ & " " & Err
End Select

End Sub
Sub AppendDeleteField(tdfTemp As TableDef, _
strCommand As String, strName As String, _
Optional varType, Optional varSize)

With tdfTemp

' Vérifie d'abord que l'objet TableDef peut être
' mis à jour. Sinon, la main est redonnée à
' la procédure appelante.
If .Updatable = False Then
MsgBox "TableDef ne peut pas être mis à jour ! " & _
"Tâche impossible à exécuter."

Exit Sub
End If

' Selon les données passées, ajoute ou supprime
' un champ dans la collection Fields de l'objet
' TableDef spécifié.
If strCommand = "APPEND" Then
.Fields.Append .CreateField(strName, _
varType, varSize)
Else
If strCommand = "DELETE" Then .Fields.Delete _
strName
End If

End With

End Sub