ADOX AVEC CRÉATION DE CLÉ MULTIPLE ET ACCESS

Option Explicit

Public Sub CreateDBWthTable()
Dim tbl As New ADOX.Table
Dim cat As New ADOX.Catalog
Dim oCon As New ADODB.Connection
Dim oInd As New ADOX.Index
Dim cNom As String
dim oField as new ADOX.column

' Saisie du nom de la Base de donnée access
cNom = InputBox("Entrer le nom de la base de donnée sans .MDB", "Saisie")
cNom = SupprCarDif(cNom) ' voir fonction SupprCarDif
If cNom <> "" Then
    ' vérifie la non existance de la base
    If Not Exist(App.Path & "\" & cNom & ".mdb") Then 'Currentproject.path pour Access
            'Création de la base de donnée
            cat.Create "Provider='Microsoft.Jet.OLEDB.4.0';data source=" & app.Path & _
                            "\" & cNom & ".mdb"
            'Creation d'une connection
            Set oCon = New ADODB.Connection
            'Ouverture d'une connection
            oCon.Open "Provider='Microsoft.Jet.OLEDB.4.0';data source=" & App.Path & "\" & _
                               cNom & ".mdb"
            'Active une connection sur la base défini avec cNom
            Set cat.ActiveConnection = oCon
            'Saisie du nom de la table
            cNom = InputBox("Entrer le nom de la table", "Saisie")
            cNom = SupprCarDif(cNom)
            If cNom <> "" Then
                tbl.Name = cNom  ' Création de la table dont le nom est contenu dans cNom
                oField.Name = "ID" 'Création d'une colonne dont le nom est "ID"
                With oField
                    .ParentCatalog = cat 'Rattachement au catalogue ouvert
                    .Type = adInteger ' un autoIncrément est entier long
                    .Properties("Autoincrement") = True 'Propriété autoincrément pour NumériqueAuto
                End With
                tbl.Columns.Append oField 'Ajout du champ NuméroAuto

                tbl.Columns.Append "Field1", adInteger ' Numérique  Long Integer
                tbl.Columns.Append "Field2", adVarWChar, 50 ' String de longueur de 50
                tbl.Columns.Append "Field3", adBoolean ' Booleen
                tbl.Columns.Append "Field4", adDouble ' Numérique Double
                tbl.Columns.Append "Field5", adLongVarBinary ' Ole Objet
                tbl.Columns.Append "Field6", adLongVarWChar ' Memo
                tbl.Columns.Append "Field7", adCurrency ' Monétaire

                oInd.Name = "Primarykey" ' création d'un index appelé 'Primarykey'
                ' Champs de l'index créé précédemment
                oInd.Columns.Append "Field1"
                oInd.Columns.Append "Field2"
                oInd.PrimaryKey = True ' Définition de l'index comme Primarykey
                tbl.Indexes.Append oInd 'ajout de l'index à la table
                cat.Tables.Append tbl 'ajout de la table à la base de donnée
            Else
                MsgBox "La création de table à été annulée", , "Annulation"
            End If
            Set cat = Nothing
            Set oCon = Nothing
    Else
        MsgBox "La création de Base de donnée à été annulée", , "Annulation"
    End If
Else
    MsgBox "La Base de donnée existe déjà.", , "Annulation"
End If
End Sub
Function SupprCarDif(pText) As String
Dim cText As String
Dim i As Integer
'Supprime le caractère différent des caractères standarts de l'alphabet
'Supprime  aussi les caractères numériques
For i = 1 To Len(pText)
    If (Asc(Mid(pText, i, 1)) >= 65 And Asc(Mid(pText, i, 1)) <= 90) Or (Asc(Mid(pText, i, 1)) >= 97 And Asc(Mid(pText, i, 1)) <= 122) Then
        cText = cText & Mid(pText, i, 1)
    End If
Next i
SupprCarDif = cText
End Function
Public Function Exist(cFile) As Boolean
' Vérifie l'existance du fichier
Dim sf
    Set sf = CreateObject("Scripting.FileSystemObject")
    Exist = sf.FileExists(cFile)
    Set sf = Nothing
End Function