Voici 2 fonctions pour créer une nouvelle table dans MS Access par code DAO et vérifier s?il n?existe pas déjà dans la base de données une table du même nom.
Voici les étapes de la fonction Creer_Toute_Table :
o vérifie si la table existe déjà et, si elle existe, que l?usager est d?accord pour la remplacer sinon on sort de la fontion
o demande le nom du champ à créer et si aucun nom n?est fournit, on sort de la fonction
o demande le type de champs (choix de 12 types) et sort de la fonction si l?usager annule cette étape
o crée le champ et l?ajoute à la collection Fields
o vérifie si l?usager désire ajouter un autre champ et recommence si oui et, si non, ajoute la table à la collection TableDefs et termine.
L?appel de la fonction se fait ainsi;
Call Creer_Toute_Table(strNomTable:="MaNouvelleTable")
Source / Exemple :
Option Explicit
Sub Test_Creer_Toute_Table()
Call Creer_Toute_Table(strNomTable:="MaNouvelleTable")
End Sub
' Crée une table avec un nombre divers de champs
Function Creer_Toute_Table(strNomTable As String) As Boolean
On Error GoTo TrappeErreur
Dim strNomChamp As String
Dim intTypeChamp As Integer
Dim tblNouvelleTable As DAO.TableDef
Dim fldNouveauChamp As DAO.Field
With CurrentDb
' Vérifie si une table du même nom existe déjà
If VerifierExistenceTable(strNomTable:=strNomTable) = True Then
If MsgBox(Prompt:="Une table nommée " & vbCrLf & _
strNomTable & vbCrLf & _
"existe déjà. Désirez-vous continuer et remplacer celle-ci ?", _
Buttons:=vbCritical + vbYesNo, _
Title:="Table existe déjà") = vbNo Then
GoTo ExitHere
Else
' Supprime la table existante
DoCmd.DeleteObject ObjectType:=acTable, _
ObjectName:=strNomTable
End If
End If
' Crée la table
Set tblNouvelleTable = .CreateTableDef(strNomTable)
Definir_Champ:
With tblNouvelleTable
strNomChamp = InputBox(Prompt:="Nom du champ", _
Title:="Saisir")
' Sort de la fonction s'il aucun nom n'a été fournit
If strNomChamp = vbNullString Then
GoTo ExitHere
End If
On Error Resume Next
intTypeChamp = InputBox(Prompt:="Nombre correspondant au type de champ;" & vbCrLf & _
" Booléen = 1" & vbCrLf & _
" Octet = 2" & vbCrLf & _
" Entier = 3" & vbCrLf & _
" Long = 4" & vbCrLf & _
" Monétaire = 5" & vbCrLf & _
" Réel simple = 6" & vbCrLf & _
" Réel double = 7" & vbCrLf & _
" Date / heure = 8" & vbCrLf & _
" Binaire = 9" & vbCrLf & _
" Texte = 10" & vbCrLf & _
" Objet Ole = 11" & vbCrLf & _
" Mémo = 12", _
Title:="Type de champ", _
Default:=10)
' Sort de la fonction si l'inputBox a été annulée
If Err.Number = 13 Then
GoTo ExitHere
End If
' Crée le champ
Set fldNouveauChamp = .CreateField(Name:=strNomChamp, _
Type:=intTypeChamp)
' Ajoute le champ à la collection Fields
.Fields.Append fldNouveauChamp
End With
' Vérifie si l'usager désire ajouter un autre champ
If MsgBox(Prompt:="Désirez-vous ajouter un autre champ ?", _
Buttons:=vbQuestion + vbYesNo, _
Title:="Nouveau champ") = vbYes Then
GoTo Definir_Champ
End If
' Ajoute la table à la collection TableDefs
.TableDefs.Append tblNouvelleTable
End With
Sortie:
Set fldNouveauChamp = Nothing
Set tblNouvelleTable = Nothing
Exit Function
TrappeErreur:
MsgBox Err.Description
Resume Sortie
End Function
' Verifie si une table existe dans la base de données courante
Function VerifierExistenceTable(strNomTable As String) As Boolean
Dim tblTable As DAO.TableDef
VerifierExistenceTable = False
For Each tblTable In CurrentDb.TableDefs
If tblTable.Name = strNomTable Then
VerifierExistenceTable = True
Exit For
End If
Next
End Function
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.