begin process at 2012 02 13 11:48:36
  Trouver un code source :
 
dans
 
Accueil > 

Code

 > 

Base de Donnees

 > ADOX AVEC CRÉATION DE CLÉ MULTIPLE ET ACCESS

ADOX AVEC CRÉATION DE CLÉ MULTIPLE ET ACCESS


 Information sur la source

Note :
10 / 10 - par 2 personnes
10,00 / 10

  • 1

  • 2

  • 3

  • 4

  • 5

  • 6

  • 7

  • 8

  • 9

  • 10
Catégorie :Base de Donnees Classé sous :ADOX, ACCESS, CREATION DB, CREATION TABLE, CLE MULTIPLE Niveau :Débutant Date de création :23/02/2005 Date de mise à jour :08/07/2008 13:49:06 Vu :4 835

Auteur : Cramfr

Ecrire un message privé
Commentaire sur cette source (26)
Ajouter un commentaire et/ou une note

 Description

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

  • 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
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.


 Historique

26 mars 2008 13:47:02 :
Ajout de l'ajout d'un champ Auto Incrémenté
26 mars 2008 17:25:37 :
Ajout de l'ajout d'un champ memo
08 juillet 2008 13:49:06 :
Ajout de l'ajout d'un champ monétaire

 Sources de la même categorie

Source avec Zip Source avec une capture BIEN ADMINISTRER LES ETUDIANTS ET LEURS CÔTES par okosa
Source avec Zip VBA EXEL GESTION DE PERSONEL NOUVEAU CONTRAT DE TRAVAI par oudlarbi
Source avec Zip Source avec une capture CREATION D'UN OBJET D'ACCÈS AUX DONNÉES par okosa
Source avec Zip Source .NET (Dotnet) MISAHORAIRE par MdelM
Source avec Zip Source avec une capture BASEDEDONNEES,GESTIONDEMALADES,DATABASSE par shadkitenge

 Sources en rapport avec celle ci

Source avec Zip VISUAL BASIC 2008 - PUBLIPOSTAGE, WORD ET ACCESS. par scn68100
Source avec Zip Source avec une capture Source .NET (Dotnet) OUVRIR BASE ACCESS PAR CLIC DROIT par Le Pivert
Source avec Zip Source avec une capture Source .NET (Dotnet) CRÉER, CONNECTER ET REMPLIR UNE BASE ACCESS par Le Pivert
Source avec Zip Source avec une capture Source .NET (Dotnet) AJOUTER - MODIFIER - SUPPRIMER DANS UNE BDD ACCESS SOUS VB20... par kewan
Source .NET (Dotnet) CONNAÎTRE LES DATATYPE ADODB COMPATIBLES AVEC LES TYPES DE D... par PWM63

Commentaires et avis

Commentaire de Tuning Max le 25/01/2006 14:52:26

Super, juste ce qu'il me fallait. je le teste tout de suite et je te dis quoi!

Commentaire de sallahedine le 10/05/2006 22:38:27

ce code il est vrément superbe il bien il faudra juste bien le comprendre sa peut étre utile dans différante application je donne 9/10

Commentaire de Cramfr le 21/09/2006 17:06:25

Merci à Tuning Max & SALLAHEDINE pour vos commentaires je commençais à désespérer de ne pas avoir de commentaire...

Sachez que vous pouvais vous passer de placer votre bibliotèque dans les références en passant les différente déclaration (tbl,Cat,oCon,oInd) en les déclarant uniquement en Object
dim tbl as Object
...
Set tbl = createObject("ADOX.Table")

A+
...

Commentaire de ggrange69 le 05/01/2007 08:56:17

Je suis à la recherche d'un code qui me permettrait de créer une base de données ACCESS et qui rendrait possible la fermeture du fichier .LDB qui accompagne l'utilisation de la base.
Or malgré la fermeture de la base et de la connexion, ce fichier qui verrouille la base ne permet pas de faire certaines opérations (ajout de password / compactage ou réparation).

Bref je vais essayé ce code pour voir s'il permet de solutionner le problème.
@+

Merci pour l'exemple ;-)

Commentaire de Cramfr le 21/08/2007 13:05:57

Bonjour,
Je réponds probablement tardivement mais je pense que celà peut servir à d'autres.

Vous me le dite si je me trompe mais il me semble que l'ajout de pwd, le compactage et la réparation doivent se faire en mode exclusif ce qui implique que si d'autres utilisateurs sont connectés à cette base impossible de la modifier. Chaque utilisateur a une session celle-ci est justement ressensé dans ce fichier .ldb .

@+
Et bonne chance

Commentaire de Sator le 26/03/2008 01:30:54

Salut j'aurais deux petites questions... quoi que ton code est super j'aurais j'aimerai faire un champs auto-incrémenté, et un champ mémo.... se serai sympat de me donné les ad... quelque chose, si tu les connais merci d'avance

@+ Sator

Commentaire de Cramfr le 26/03/2008 13:55:12

Merci pour tes commentaires,

J'ai fait une modification en ce sens pour les auto-incrémenté.
Pour ce qui est de mémo il me semble que le mémo le type est 203 essai avec la valeur plutôt qu'avec la constante ad... .

A+

Cramfr

Commentaire de Cramfr le 26/03/2008 14:36:39

re bonjour,
Après recherche, le type mémo correspond à la constante adLongVarWChar
Cordialement,
@++
Cramfr

Commentaire de Sator le 26/03/2008 15:39:13 10/10

Merci infiniement

Commentaire de Sator le 05/04/2008 17:00:46

j'ai encore un petit soucis.... pour changer, j'ai essayer un certain nombre de chose mais visiblement tu t'y connais bien plus que moi, donc plutôt que de perdre encore des heures de recherche, je te soumet mon problème qui pourra servir à bien d'autres... Pourrais-tu nous montrer comment rajouter, une option password? ou nous dire comment on fait? Stp se serais super sympat.

merci d'avance
@+ Sator

Commentaire de Cramfr le 07/04/2008 12:44:12

Bonjour,
Il semble après quelques recherches (non approfondi) que ce que tu cherches ne se trouve pas dans ADOX. Je pense qu'en utilisant DAO avec l'objet Field et la propriété Inputmask avec comme valeur "password" devrait fonctionner.
@+
Cramfr

Commentaire de Sator le 07/04/2008 13:58:14

je te remercie je vais chercher...
(dommage que je ne peux pas te mettre 2*10)



@+ Sator

Commentaire de Cramfr le 07/04/2008 15:28:05

Merci ;-)
@+ Cramfr

Commentaire de Sator le 22/04/2008 15:34:10

hello... c'est encore moi... désolé mais là ça fait un petit moment que je cherche et j'ai pas trouvé...

en fait j'ai repris ta source et j'ai fais une boucle devant créer deux bases chacune pour l'instant comporte une table... donc no soucis pour la première, en revanche quand j'entame la seconde le programe me dit :l'opération demandé n'est pas possible dans ce contexte...
sur la ligne with ofield
.Type = adInteger ' un autoIncrément est entier long

bref là je vois pas... pourquoi la deuxième fois et pas la première....

merci pour ta réponse...

@+ Sator

Commentaire de Sator le 23/04/2008 05:14:27

En fait j'ai trouvé il faut vider les
Set oField = Nothing
Set oInd = Nothing
Set tbl = Nothing

avant et ça passe

Commentaire de Cramfr le 24/04/2008 10:26:14

Dsl,
Ma femme a accouché d'un future programmeur et je n'ai pas pu te répondre ;-)

Cordialement,
Cramfr

Commentaire de Sator le 25/04/2008 17:00:50

Pas Grave, toutes mes félicitations.... Je te souhaite bonne chance et bon courage...
En espérant que tout le monde se portent bien...

@+ Sator

Commentaire de Sator1 le 07/07/2008 15:12:30

Hello, de nouveau un petit soucis....

Sans gravité, mais embêtant pour mon appli.
j'aurais besoin d'un champ monétaire taille fixe... si t'as ça dans un tiroir... je te remercie... d'avance pour l'en sortir.

@+ Sator

Commentaire de Cramfr le 08/07/2008 14:03:42

c'est fait ;-)

Commentaire de Sator1 le 08/07/2008 19:33:43

Merci infiniment...

@+ Sator

Ps: en espérant que tout le monde va bien chez toi...

Commentaire de Sator1 le 08/07/2008 19:37:17

re-moi... dis-moi, si j'emploi: tbl.Columns.Append "Field7", adCurrency ' Monétaire

et que j'emploie les francs Suisse...
ou vice versa je me retrouve avec un Soucis...

Commentaire de Cramfr le 09/07/2008 09:58:52

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

Commentaire de Cramfr le 09/07/2008 09:59:51

Tout le monde va bien mise à part la fatigue des longues nuits avec peu de sommeil ;-)

Commentaire de Sator1 le 10/07/2008 11:31:38

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

Commentaire de Cramfr le 10/07/2008 14:12:44

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

Commentaire de Sator1 le 11/07/2008 01:21:40 10/10

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

@+ Sator

 Ajouter un commentaire


Discussions en rapport avec ce code source dans le forum

les etats access [ par henri ] comment faire pour imprimer un etat access par un code VisualBasic ? VB & Access 2000 [ par Uther ] J'aimerais savoir comment faire pour connecter un DAO datacontrol à une BD Access 2000 sans que le message de "Base de donnee invalide" n'intervienne. Copier un etat access vers Excel [ par Ol ] Je voudrais copier un etat access (un tableau) vers Excel sans perdre la mise en page (ou le moins possible).Comment faire?? Exécutable avec Access [ par janus ] Nous avons problème à créer un exécutable en utilisant Vb avec Access, en considérant que le logiciel Access ne doit pas être obligatoire.C'est à dire enregistrer un document word [ par Christian ] Bonjour à tous, et bravo pour la qualité de ce site sur VB "En Français".Depuis quelques jours je me prend la tête pour enregistrer un document Word à Imprimer état Access sous VB [ par janus ] Le problème est de pouvoir imprimer un état Access sous VB, et ce sans que le logiciel Access ne s'ouvre.Merci d'avance Accès à une base de donnée Access sous VB [ par lolo ] J'aimerais réaliser une sorte de moteur de recherche en VB :il y a différents champs à remplir par l'utilisateur; une fois ces derniers remplis l'appl VB et formulaires access [ par jabri ] Est ce posssible d'appeler à partir d'un programme VB un formulaire appartenet a access (en gardant le look access) et comment merci... Outlook et Access 2000 [ par taz ] Comment exporter ou importer les informations du calendrier d'Outlook 2000 ans Access 2000


Nos sponsors


Sondage...

CalendriCode

Février 2012
LMMJVSD
  12345
6789101112
13141516171819
20212223242526
272829    

Consulter la suite du CalendriCode

Photothèque

 
Développement réalisé par Nicolas SOREL (Nix) avec l'aide de : Cyril DURAND et Emmanuel (EBArtSoft), Merci à Vincent pour ses précieux conseils.
CodeS-SourceS.com© Toute reproduction même partielle est interdite sauf accord écrit du Webmaster
CodeS-SourceS.com© est une marque déposée tous droits réservés

Google Coop CodeS-SourceS Google Coop CodeS-SourceS
Temps d'éxécution de la page : 13,244 sec (4)

Nous contacter | Annoncer sur CodeS-SourceS | Mentions légales