1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93
   |  
Private Sub ConnecterBase(ConnectBD As Object, _
                          Optional Rs)
 
    Set ConnectBD = CreateObject("ADODB.Connection")
    If Not IsMissing(Rs) Then
        Set Rs = CreateObject("ADODB.Recordset")
    End If
 
    With ConnectBD
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        'ici changer le chemin de la base
        .ConnectionString = "D:\stats.mdb"
        .Open
    End With
 
End Sub
 
Private Sub CreerTable()
 
    Dim ConnectBD As Object
    Dim Rs As Object
    Dim Catalogue As Object
    Dim Table As Object
    Dim Idx As Object
    Dim NomTable As String
 
    NomTable = "MaTable"
 
    'connecte la base de données
    ConnecterBase ConnectBD, Rs
 
    'initialise les objets ADOX
    Set Catalogue = CreateObject("ADOX.Catalog")
    Set Table = CreateObject("ADOX.Table")
    Set Idx = CreateObject("ADOX.Index")
 
    'connecte le catalogue
    'à la base de données
    Catalogue.ActiveConnection = ConnectBD
 
    'création de la table
    With Table
        .Name = NomTable
        With .Columns
            .Append "Nom", 202, 20
            .Append "Salaire", 3
            .Append "Prime1", 3
            .Append "Prime2", 3
            .Append "DateEntree", 7
        End With
    End With
 
    'si la table existe, demande si écrasement
    On Error Resume Next
    With Catalogue
        .Tables.Append Table
        If Err <> 0 Then
            If MsgBox("La table '" & NomTable _
            & "' existe déjà, l'écraser ?", _
            vbYesNo + vbQuestion) = vbYes Then
                .Tables.Delete NomTable
                .Tables.Append Table
            Else
                Exit Sub
            End If
        End If
    End With
    On Error GoTo 0
 
    'création de l'index clé primaire
    With Idx
        .Name = "ClePrim"
        .Columns.Append "Nom"
        .Unique = True
        .PrimaryKey = True
    End With
 
    'ajoute l'index
    Table.Indexes.Append Idx
 
    'rempli la table
    AjoutDansTable ConnectBD, Rs, NomTable
 
    'ferme la connection
    ConnectBD.Close
 
    Set Table = Nothing
    Set Catalogue = Nothing
    Set Rs = Nothing
    Set ConnectBD = Nothing
 
End Sub | 
Partager