enregistrement autre base de donnée

Version imprimable

Bonjour à tous,

voici mon sujet,
j'ai une base de donnée avec:
un formulaire indépendant pour créer des enregistrements nommé Feleveur1
une table nommée Base Nationale
Sur le formulaire je remplis les champs et avec le bouton on enregistre dans la base nationale par un code VBA, là tout va bien.
Mais je voudrais mettre la table Base nationale dans une autre base de donnée et lié cet table dans la base active.
j'ai effectué plusieurs tentative mais quand je clique sur le bouton enregistrement, j'ai un débogage sur la ligne de code.

Code:

Set MonJeu = Mabd.OpenRecordset("Base Nationale", dbOpenTable)

je voulais mettre mon fichier, mais trop gros

Ci-joint code complet:

Code:

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
Private Sub benregparticipant_Click()
 
    Dim Mabd As Database, MonJeu As Recordset, rep As Integer, aa
    'v?rifie si REGION, SOUCHE, NOM sont renseign?s
    If IsNull(Forms![F?leveurs1]![ELE_SOUCHE]) Then
    rep = MsgBox("renseignez le N? de SOUCHE", vbOKOnly)
    Forms![F?leveurs]![ELE_SOUCHE1].SetFocus
    GoTo LL
    End If
    If IsNull(Forms![F?leveurs1]![ELE_REGION]) Then
    rep = MsgBox("renseignez la REGION", vbOKOnly)
    Forms![F?leveurs1]![ELE_REGION].SetFocus
    GoTo LL
    End If
    If IsNull(Forms![F?leveurs1]![ELE_NOM]) Then
    rep = MsgBox("renseignez le NOM", vbOKOnly)
    Forms![F?leveurs1]![ELE_NOM].SetFocus
    GoTo LL
    End If
 
    'V?rifie si l'?leveur est d?j? inscrit
    Set Mabd = CurrentDb
    Set MonJeu = Mabd.OpenRecordset("Base Nationale", dbOpenTable)
    If MonJeu.BOF = True Then GoTo MM
    MonJeu.MoveFirst
    Do Until MonJeu.EOF
    If MonJeu![ELE_SOUCHE] = Forms![F?leveurs1]![ELE_SOUCHE] And MonJeu![ELE_PAYS] = Forms![F?leveurs1]![ELE_PAYS] And MonJeu![ELE_REGION] = Forms![F?leveurs1]![ELE_REGION] Then
    rep = MsgBox("l'?leveur est d?j? inscrit", vbOKOnly)
    GoTo LL
    End If
    MonJeu.MoveNext
    Loop
MM:
    'inscription dans la table Base Nationale
    MonJeu.AddNew
    MonJeu![ELE_PAYS] = Forms![F?leveurs1]![ELE_PAYS]
    MonJeu!ELE_REGION = Forms![F?leveurs1]![ELE_REGION]
    MonJeu!ELE_CLUB = Forms![F?leveurs1]![ELE_CLUB]
    MonJeu![ELE_SOUCHE] = Forms![F?leveurs1]![ELE_SOUCHE]
    MonJeu!ELE_QUALITE = Forms![F?leveurs1]![ELE_QUALITE]
    MonJeu!ELE_NOM = Forms![F?leveurs1]![ELE_NOM]
    MonJeu!ELE_PRENOM = Forms![F?leveurs1]![ELE_PRENOM]
    MonJeu![ELE_ADRESSE] = Forms![F?leveurs1]![ELE_ADRESSE]
    MonJeu![ELE_CPOSTAL] = Forms![F?leveurs1]![ELE_CPOSTAL]
    MonJeu![ELE_VILLE] = Forms![F?leveurs1]![ELE_VILLE]
    MonJeu!ELE_COURRIEL = Forms![F?leveurs1]![ELE_COURRIEL]
    MonJeu![ELE_TELEPHONE] = Forms![F?leveurs1]![ELE_TELEPHONE]
    MonJeu![ELE_NP] = Forms![F?leveurs1]![ELE_NP]
    MonJeu![ELE_CIVILITE] = Forms![F?leveurs1]![ELE_CIVILITE1]
 
    aa = DMax("[ELE_NUMERO]", "Base Nationale")
    If IsNull(aa) Then
    MonJeu!ELE_NUMERO = 1
    Else
    MonJeu!ELE_NUMERO = aa + 1
    End If
    MonJeu.Update
    MonJeu.Close
    rep = MsgBox("L'ELEVEUR EST ENREGISTRE", vbOKOnly, "CONFIRMATION")
LL:
End Sub

Merci pour vos réponses
Cordialement

Salut
Il y a plus simple pour tester et insérer un recordset d'un form indépendant vers une bdd distante

BaseNatDistante.accdb est la bdd distante au format accdb (ou mdb)
tbl_BaseNationale est la tbl liée dans votre bdd active
If DCount() vérifie la non présence d'un doublon (nom, region, souche) dans la tbl_BaseNationale

EDIT 20191125 20:02
A propos des tests sur vos 3 textbox, je ne suis pas trop convaincu de leur efficacité.
Le plus simple affecter une règle de validation sur les textbox Valide si : <>"" et Message si erreur : Veuillez saisir ...Ou vba

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Private Sub ELE_NOM_Exit(Cancel As Integer)
If Len(Me.ELE_NOM & vbNullString) = 0 Then
  MsgBox "renseignez le ELE_NOM", vbOKOnly
  Cancel = True
  Me.ELE_NOM.SetFocus
End If
End Sub
Private Sub ELE_REGION_Exit(Cancel As Integer)
If Len(Me.ELE_REGION & vbNullString) = 0 Then
  MsgBox "renseignez le ELE_REGION", vbOKOnly
  Cancel = True
  Me.ELE_REGION.SetFocus
End If
End Sub
Private Sub ELE_SOUCHE_Exit(Cancel As Integer)
If Len(Me.ELE_SOUCHE & vbNullString) = 0 Then
  MsgBox "renseignez le ELE_SOUCHE", vbOKOnly
  Cancel = True
  Me.ELE_SOUCHE.SetFocus
End If
End Sub

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Private Sub benregparticipant_Click()
DoCmd.SetWarnings False
If DCount("*", "tbl_BaseNationale", "ELE_NOM = '" & Me.ELE_NOM & "' AND ELE_SOUCHE = '" & Me.ELE_SOUCHE & "' AND ELE_REGION = '" & Me.ELE_REGION & "'") = 0 Then
 
    Me.ELE_NUMERO.Value = Format(Nz(DMax("[ELE_NUMERO]", "[tbl_BaseNationale]"), 0) + 1)
 
    CurrentDb.Execute "INSERT INTO tbl_BaseNationale (ELE_NUMERO, ELE_CIVILITE, ELE_NOM, ELE_PRENOM, ELE_ADRESSE, ELE_CPOSTAL, ELE_VILLE, ELE_REGION, ELE_PAYS, ELE_COURRIEL, ELE_TELEPHONE, ELE_CLUB, ELE_SOUCHE, ELE_QUALITE, ELE_NP)" _
    & " In 'C:\Users\...\BaseNatDistante.accdb'" _
    & " VALUES (" & Me.ELE_NUMERO & ", '" & Me.ELE_CIVILITE & "', '" & Me.ELE_NOM & "', '" & Me.ELE_PRENOM & "', '" & Me.ELE_ADRESSE & "', '" & Me.ELE_CPOSTAL & "', '" & Me.ELE_VILLE & "', '" & Me.ELE_REGION & "', '" & Me.ELE_PAYS & "', '" & Me.ELE_COURRIEL & "', '" & Me.ELE_TELEPHONE & "', '" & Me.ELE_CLUB & "', '" & Me.ELE_SOUCHE & "', '" & Me.ELE_QUALITE & "', '" & Me.ELE_NP & "')", dbFailOnError
DoCmd.SetWarnings True
Else
    MsgBox "est déjà enregistré dans la bdd nationale !", vbOKOnly
End If
End Sub

1 pièce(s) jointe(s)

Bonjour à tous et bonjour Hyperion13,
Merci pour votre réponse,
j'ai bien vu votre code mais je n'avais pas eu le temps de tester, mais là, c'est fait.
Problème, je n'ai pas réussi à le faire fonctionné, faut il mettre la Base_Nationale sur un autre PC pour teste où pouvons nous la laisser sur le même PC.
il me retourne un débogage sur la ligne CurrentDb.Execute
je joint mon fichier pour verrification.

Cordialement
Pièce jointe 520187

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Private Sub benregparticipant_Click()
 
    DoCmd.SetWarnings False
If DCount("*", "Base_Nationale", "ELE_NOM = '" & Me.ELE_NOM & "' AND ELE_SOUCHE = '" & Me.ELE_SOUCHE & "' AND ELE_REGION = '" & Me.ELE_REGION & "'") = 0 Then
 
    Me.ELE_NUMERO.Value = Format(Nz(DMax("[ELE_NUMERO]", "[Base_Nationale]"), 0) + 1)
 
    CurrentDb.Execute "INSERT INTO Base_Nationale (ELE_NUMERO, ELE_CIVILITE, ELE_NOM, ELE_PRENOM, ELE_ADRESSE, ELE_CPOSTAL, ELE_VILLE, ELE_REGION, ELE_PAYS, ELE_COURRIEL, ELE_TELEPHONE, ELE_CLUB, ELE_SOUCHE, ELE_QUALITE, ELE_NP)" _
    & " In 'C:\Users\jacques\Desktop\ESSAI\FICHIER_BASE\Base_Nationale.accdb'" _
    & " VALUES (" & Me.ELE_NUMERO & ", '" & Me.ELE_CIVILITE & "', '" & Me.ELE_NOM & "', '" & Me.ELE_PRENOM & "', '" & Me.ELE_ADRESSE & "', '" & Me.ELE_CPOSTAL & "', '" & Me.ELE_VILLE & "', '" & Me.ELE_REGION & "', '" & Me.ELE_PAYS & "', '" & Me.ELE_COURRIEL & "', '" & Me.ELE_TELEPHONE & "', '" & Me.ELE_CLUB & "', '" & Me.ELE_SOUCHE & "', '" & Me.ELE_QUALITE & "', '" & Me.ELE_NP & "')", dbFailOnError
DoCmd.SetWarnings True
Else
    MsgBox "est d?j? enregistr? dans la bdd nationale !", vbOKOnly
End If
End Sub]

27/11/2019, 11h18
hyperion13

1 pièce(s) jointe(s)

Salut
Les 2 bdd peuvent être sur le même PC.
Par contre je viens de tester votre bdd Base_essai, (liaison table mise à jour) elle fonctionne très bien.

1 pièce(s) jointe(s)

Re,
j'ai vu votre message et là je n'y comprends plus rien, j'ai essayé de changer de dossier et toujours un débogage:
1er message:
Pièce jointe 520264

Code:

1
2
3
 CurrentDb.Execute "INSERT INTO Base_Nationale (ELE_NUMERO, ELE_CIVILITE, ELE_NOM, ELE_PRENOM, ELE_ADRESSE, ELE_CPOSTAL, ELE_VILLE, ELE_REGION, ELE_PAYS, ELE_COURRIEL, ELE_TELEPHONE, ELE_CLUB, ELE_SOUCHE, ELE_QUALITE, ELE_NP)" _
    & " In 'D:\ESSAI\FICHIER_BASE\Base_Nationale.accdb'" _
    & " VALUES (" & Me.ELE_NUMERO & ", '" & Me.ELE_CIVILITE & "', '" & Me.ELE_NOM & "', '" & Me.ELE_PRENOM & "', '" & Me.ELE_ADRESSE & "', '" & Me.ELE_CPOSTAL & "', '" & Me.ELE_VILLE & "', '" & Me.ELE_REGION & "', '" & Me.ELE_PAYS & "', '" & Me.ELE_COURRIEL & "', '" & Me.ELE_TELEPHONE & "', '" & Me.ELE_CLUB & "', '" & Me.ELE_SOUCHE & "', '" & Me.ELE_QUALITE & "', '" & Me.ELE_NP & "')", dbFailOnError

je ne suis pas doué en VBA

Merci

27/11/2019, 16h49
jaquot14

re,

je viens de résoudre le problème, cela fonctionne supère bien, j'ai recopier le lien lorsque j'ai créer la liaison et coller dans le code VBA et là cela fonctionne.
Un très grand merci à vous Hypérion13
Merci
Cordialement

Bonjour à tous,

j'aurai une autre question,
j'aimerai mettre à la fin du code d'enregistrement une msgbox me disant que l' enregistrement est bien fait.
j'avais cela sur mon ancien code vba, j'ai essayé de le mettre mais quand la personne n'est pas déjà inscrite, j'ai le message, mais si elle est déjà inscrite je l'ai aussi???????
auriez vous une idée.
Merci cordialement

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Private Sub benregparticipant_Click()
 
    DoCmd.SetWarnings False
If DCount("*", "Base_Nationale", "ELE_NOM = '" & Me.ELE_NOM & "' AND ELE_SOUCHE = '" & Me.ELE_SOUCHE & "' AND ELE_REGION = '" & Me.ELE_REGION & "'") = 0 Then
 
    Me.ELE_NUMERO.Value = Format(Nz(DMax("[ELE_NUMERO]", "[Base_Nationale]"), 0) + 1)
 
    CurrentDb.Execute "INSERT INTO Base_Nationale (ELE_NUMERO, ELE_CIVILITE, ELE_NOM, ELE_PRENOM, ELE_ADRESSE, ELE_CPOSTAL, ELE_VILLE, ELE_REGION, ELE_PAYS, ELE_COURRIEL, ELE_TELEPHONE, ELE_CLUB, ELE_SOUCHE, ELE_QUALITE, ELE_NP)" _
    & " In 'C:\Users\jacques\Documents\ESSAI\FICHIER_BASE.accdb'" _
    & " VALUES (" & Me.ELE_NUMERO & ", '" & Me.ELE_CIVILITE & "', '" & Me.ELE_NOM & "', '" & Me.ELE_PRENOM & "', '" & Me.ELE_ADRESSE & "', '" & Me.ELE_CPOSTAL & "', '" & Me.ELE_VILLE & "', '" & Me.ELE_REGION & "', '" & Me.ELE_PAYS & "', '" & Me.ELE_COURRIEL & "', '" & Me.ELE_TELEPHONE & "', '" & Me.ELE_CLUB & "', '" & Me.ELE_SOUCHE & "', '" & Me.ELE_QUALITE & "', '" & Me.ELE_NP & "')", dbFailOnError
DoCmd.SetWarnings True
Else
    MsgBox "est d?j? enregistr? dans la bdd nationale !", vbOKOnly
End If
   rep = MsgBox("L'ELEVEUR EST ENREGISTRE", vbOKOnly, "CONFIRMATION")
End Sub

28/11/2019, 14h50
hyperion13

Déplacez L15 entre L10/L11
28/11/2019, 15h48
jaquot14

Merci hypérion13,
Nickel, je n'avais pas pensé à cette solution.
j'aurais une autre question mais je vais essayer de chercher avant de la poser, si je ne trouve pas, je reviendrai.
j'aimerais bien connaitre le vba comme vous, je m'améliore au fil du temps, mais pas facile.
Encore merci pour votre aide

Bonsoir à tous,
je reviens vers vous pour un autre problème que je n'arrive pas à résoudre, mais je que pour Hyperion13, ce ne sera pas un problème car il m'avait donné le code VBA pour le formulaire éleveur1.
J'ai recopier ce code dans le formulaire F_inscrip_acheteur1 mais j'ai une erreur sur la ligne 9 VALUES
Je joint mom fichier.

si vous pouvez m'aider
Merci
cordialement

Code:

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
 
Private Sub benregparticipant_Click()
 
    DoCmd.SetWarnings False
    ' verrifie si l'acheteur est d?j? inscrit
If DCount("*", "Base_N_Acheteur", "NOMA = '" & Me.NOMA & "' AND PRENOMA = '" & Me.PRENOMA & "' AND ADRESSEA = '" & Me.ADRESSEA & "' AND VILLEA = '" & Me.VILLEA & "'") = 0 Then
 
    Me.NUMEROA.Value = Format(Nz(DMax("[NUMEROA]", "[Base_N_Acheteur]"), 0) + 1)
 
    'inscrption dans la base nationale acheteur
    CurrentDb.Execute "INSERT INTO Base_N_Acheteur (NUMEROA, CIVILITEA, NOMA, PRENOMA, ADRESSEA, CPA, VILLEA, REGIONA, PAYSA, EMAIL, TELEPHONEA, CLUBA, SOUCHEA, QUALITEA, NPA)" _
    & " In 'C:\Users\jacques\Documents\ESSAI\FICHIER_BASE.accdb'" _
    & " VALUES (" & Me.NUMEROA & ", '" & Me.CIVILITEA & "', '" & Me.NOMA & "', '" & Me.PRENOMA & "', '" & Me.ADRESSEA & "', '" & Me.CPA & "', '" & Me.VILLEA & "', '" & Me.REGIONA & "', '" & Me.PAYSA & "', '" & Me.E - MAIL & "', '" & Me.TELEPHONEA & "', '" & Me.CLUBA & "', '" & Me.SOUCHEA & "', '" & Me.QUALITEA & "', '" & Me.NPA & "')", dbFailOnError
 
    rep = MsgBox("L'ACHETEUR EST ENREGISTRE", vbOKOnly, "CONFIRMATION")
DoCmd.SetWarnings True
Else
    MsgBox "L'ACHETEUR EST DEJA ENREGISTRE DANS LA BASE NATIONALE !", vbOKOnly, "AFFIRMATION"
 End If
 DoCmd.Close
 Dim stDocName As String
    Dim stLinkCriteria As String
 
    stDocName = "F_inscrip_Acheteurs1"
    DoCmd.OpenForm "F_inscrip_Acheteurs1", acNormal, "", "", , acDialog
 
End Sub

04/12/2019, 20h07
jaquot14

re,
rectificatif, l'erreur n'est pas sur la ligne 9 mais 13
encore merci pour votre aide
cordialement
04/12/2019, 20h11
jaquot14

1 pièce(s) jointe(s)

re,
j'ai oublié de joindre mon fichier.
Merci
04/12/2019, 21h10
hyperion13

1 pièce(s) jointe(s)

Bonsoir
Pourtant ça marche chez moi !

Éventuellement en L13 supprimez tous les Me.
04/12/2019, 21h23
tee_grandbois

bonsoir,
lorsqu'on utilise des caractères réservés (*,+,-,=, / ...) pour nommer des contrôles il faut s'attendre à des effets de bord :
saisir ceci dans VBA Me.E-MAIL donnera fatalement Me.E - MAIL car le signe - sera interprété comme faisant partie d'un calcul de soustraction.
Ajoute des crochets:

Code:

& Me.[E-MAIL]
05/12/2019, 08h34
jaquot14

bonjour,

Merci pour vos réponses, j'ai suivi le conseille de Tee_grandbois, j'ai modifié E-MAIL par EMAIL pour le nom du textbox et cela fonctionne.
Je retiens la leçon des caractères spéciaux.
Merci à vous deux et bonne journée.
cordialement
Jac
05/12/2019, 20h22
jaquot14

1 pièce(s) jointe(s)

Bonsoir,
Je vous recontacte car j'ai un autre souci avec le code de Hyperion13 qui fonctionne très bien dans certains formulaires.
Dans les fichier essai que je vais joindre j'ai ajouté:
un formulaire: F_inscrip_acheteurs
une requête pour la liste de choix acheteurs
une table liée: Acheteurs_C
je voudrais que le code vba du formulaire F_inscrpt_acheteur vérifie que le champ NUMEROA et le champ DT ne soient déjà inscris dans la table Acheteurs_C.

je me retrouve avec un débogage ligne 6

j'espère que je me suis bien expliqué.
NUMEROA est numérique et DT un champ date
je ne sais pas si cela est possible.
lorsque je mets d'autre champ, cela fonctionne.
Désolé de faire encore appel a vous.
Merci
cordialement