Adox avec création de clé multiple et access

Soyez le premier à donner votre avis sur cette source.

Snippet vu 6 203 fois - Téléchargée 34 fois

Contenu du snippet

Ce code n'est pas très compliqué en soit. Il s'agit juste de créer une base de donnée access et une table Avec ADOX (Déjà vu sur ce site) mais avec une clé multiple. Je ne crois pas l'avoir vu...
Ce code utilise les références :
Microsoft ActiveX Data Objects 2.1 library
Microsoft ADO Ext. 2.8 for DLL and Security

C'est mon premier code déposé ici, j'espère que cela pourra vous aider car j'ai un peu cherché pour comprendre son fonctionnement.

Source / Exemple :


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

Conclusion :


Si des vous avez des problèmes ou des commentaires à me faire parvenir je reste à votre disposition.

A voir également

Ajouter un commentaire

Commentaires

Messages postés
30
Date d'inscription
vendredi 27 août 2004
Statut
Membre
Dernière intervention
18 août 2008

Et tu aurais une manière pour régler automatiquement ce champ à Fixe?

@+ Sator
Messages postés
160
Date d'inscription
mercredi 24 novembre 2004
Statut
Membre
Dernière intervention
8 juillet 2008

Bonjour,
Comme il existe qu'une seule monnaie pour un PC il est en effet préférable de le mettre fixe pour pouvoir avoir le type de monnaie dans la légende de la rubrique.

@+
Cramfr
Messages postés
30
Date d'inscription
vendredi 27 août 2004
Statut
Membre
Dernière intervention
18 août 2008

Faites des gosses vous verrez du pays... qu'ils disaient...

Référence à "engagez-vous et vous verrez du pays..."

en fait je t'ai posé la question car effectivement je suis réglé sur francs suisse, il se trouve que je prends sur le net un formulair où les chiffres sont indiqué en euro... ensuite je recomence avec un autre formulair mais celui-ci en francs suisse... et j'avais résolu le problème en le faisant manuellement, avec la partie, le format monnétair fixe... d'où ma question...

Merci @+ Sator
Messages postés
160
Date d'inscription
mercredi 24 novembre 2004
Statut
Membre
Dernière intervention
8 juillet 2008

Tout le monde va bien mise à part la fatigue des longues nuits avec peu de sommeil ;-)
Messages postés
160
Date d'inscription
mercredi 24 novembre 2004
Statut
Membre
Dernière intervention
8 juillet 2008

bonjour,
heu, quelle monnaie a tu définis dans ton panneau de configuration options régionales et linguistique ? si c'est euro tu as par défaut l'euro si tu es en francs suisse ta monnaie par défaut sera le franc suisse.
sinon tu le définis sans monnaie affiché et tu définis un masque de saisie dans ton formulaire ou fenêtre.
@+
Cramfr
Afficher les 26 commentaires

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.