Création assistée par code dao d?une table dans ms access ? nombre et type de champs selon les besoins.

Soyez le premier à donner votre avis sur cette source.

Vue 9 047 fois - Téléchargée 809 fois

Description

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

Codes Sources

A voir également

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.