CRÉATION ASSISTÉE PAR CODE DAO D’UNE TABLE DANS MS ACCESS – NOMBRE ET TYPE DE CHAMPS SELON LES BESOINS.

---

Commentaire sur cette source (0)
Ajouter un commentaire et/ou une note

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")

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

Pour les "Membres Club", vous pouvez télécharger directement un fichier contenu dans le zip sans télécharger le zip en entier !

Télécharger le zip

• FONCTION DAO PERMETTANT DE VÉRIFIER SI UNE TABLE POSSÈDE UN INDEX
• UTILISATION D’UNE COLLECTION POUR GÉRER TOUS LES PARAMÈTRES D’UNE APPLICATION MS ACCESS
• REQUÊTE SQL UNION DE MS ACCESS ERRONÉE SANS LE PRÉDICAT ALL.

• GESTION DES INTERVENTIONS SUR UN PARC MACHINES
• USF_DATES.XLS (API VBA)
• UN GRAPHIQUE 3D TOUT EN MOUVEMENT
• GESTION DES STYLES DE MS WORD 2003
• CONTROL_PROCESS PROCESS_VIEWER

• OPEN ACCESS MDB
• CONNEXION BASES DE DONNÉES
• UN ACCESS MOIN COMPLET (IL MANQUE L'ÉDITEUR DE BASE DE DONNÉ)
• ACCESS VBA ZIP UNZIP
• FONCTION DAO PERMETTANT DE VÉRIFIER SI UNE TABLE POSSÈDE UN INDEX