none
Envoyer un email via Outlook depuis ACCESS à plusieurs personnes basé sur une requête RRS feed

  • Question

  • Bonjour,

    J'aimerai pouvoir envoyer un message à toutes les personnes apparaissant dans la requête nommé "R_Mailing" malheureusement le message s'ouvre uniquement sur la première adresse email.
    Je ne sais pas comment adapter une boucle dans mon code qui viendrait prendre toutes les personnes de ma requête.

    Voici le code que je déclenche depuis un bouton sur un formulaire :

    Private Sub EnvoiMailing_Click()
        Dim MonOutlook As Object
        Dim MonMessage As Object
        Set MonOutlook = CreateObject("Outlook.Application")
        Set MonMessage = MonOutlook.createitem(0)
     
        MonMessage.To = DLookup("[Email]", "R_Mailing", "[Actif]=-1")
        MonMessage.Subject = Forms![Mailing]![Objet]
        MonMessage.body = Forms![Mailing]![Corps]
     
        MonMessage.Display
     
        Set MonOutlook = Nothing
        Set MonMessage = Nothing
    End Sub
    Ma requête "R_Mailing" comporte le champ "Email" qui affiche les emails des membres actifs (coche oui/non)

    En vous remerciant pour votre aide


    Franck

    mardi 22 septembre 2015 13:54

Toutes les réponses

  • Bonjour,

    La réponse à votre question se trouve sur cet article (en anglais) Send Outlook Email from Access VBA

    En fait, vous devez boucler sur chaque enregistrement de la requête et pour chaque enregistrement créer le courriel.


    En espérant avoir pu rendre service (MehdiH)
    Retrouvez moi sur Office Users

    mardi 29 septembre 2015 13:13
  • Bonjour, Merci pour votre réponse Comment ecriveriez-vous cette boucle dans le cas présent ? En vous remerciant pour votre aide ! Franck

    Franck

    mardi 29 septembre 2015 22:17
  • Bonjour Franck,

    Pour répondre à votre question, voici le scénario

    Une base de données avec :

      • La table "Contacts" contenant deux champs ID et Courriel (texte et non pas hypertexte)
      • La requête "Liste publipostage" qui sera la source des emails et qui contenant le champ "Courriel"
      • Le formulaire "Send emails" qui contient
      • la zone de texte "txtObjet" pour saisir l'objet du message.
      • la zone de texte "txtMessage" pour saisir le corps du message.
      • le bouton "cmdSend" pour lancer la procédure de création et d'envois des emails.

    Le code du bouton "cmdSend" est le suivant :

    Private Sub cmdSend_Click()
        
        'Macro créée par Mehdi HAMMADI le 30/09/2015
        'Objet : Automation Outlook pour l'envois de courriel en utilisant comme source des adrsses électronique une requête
        'Macro inspirée du code disponible à cette adresse : http://www.blueclaw-db.com/access_email_send_outlook.htm
        
        'Ne pas oublier d'ajouter une référence à la bibliothèque d'objets Microsoft Outlook xx.x
    
        'Déclaration des variables
        Dim rstCourriels As DAO.Recordset
        Dim appOutlook As Outlook.Application
        Dim MailOutlook As Outlook.MailItem
        
        'Basé le recordset sur la requête "Liste publimailing"
        Set rstCourriels = CurrentDb.OpenRecordset("Liste publimailing")
        
        'Aller au premier enregistrement
        rstCourriels.MoveFirst
        
        'boucler jusqu'à la fin du recordset
        Do While Not rstCourriels.EOF
        
            'Si le champ "Courriel" est vide passer à l'enregistrement suivant
            If IsNull(rstCourriels!Courriel) Then GoTo saut_enregistrement
            
            'Définition de l'objet appliaction Outlook
            Set appOutlook = CreateObject("Outlook.application")
            'Créer un nouvel Email
            Set MailOutlook = appOutlook.CreateItem(olMailItem)
            
            With MailOutlook
                
                'Affecter l'adresse électronique
                .To = rstCourriels!Courriel
                
                'Affecter l'objet du message
                .Subject = txtObjet
                
                'Affecter le corp du message
                .Body = txtMessage
                
                'Envoyer le message
                .Send
            
            End With
    
    saut_enregistrement:
            'Passer à l'enregistrement suivant
            rstCourriels.MoveNext
        Loop
        
        'Fermet le ricord set
        rstCourriels.Close
        
        'Message d'information
        MsgBox "Les messages ont été créés, vérifier au niveau d'Outlook", vbApplicationModal + vbInformation + vbOKOnly, "Envois de messages"
        
        'Décharger les objets en mémoire
        Set MailOutlook = Nothing
        Set appOutlook = Nothing
        Set rstCourriels = Nothing
        
    End Sub
    


    En espérant avoir pu rendre service (MehdiH)
    Retrouvez moi sur Office Users

    • Proposé comme réponse Oliv- jeudi 8 octobre 2015 08:11
    mercredi 30 septembre 2015 08:42
  • Bonjour Mehdi, Merci beaucoup pour ce code !!! En plus très bien expliqué Je vais l'essayer ce weekend Quel objet dans les contrôles active x dois-je ajouter à la bibliothèque pour Microsoft Outlook xx.x ? En vous remerciant pour votre aide 😀 Franck
    • Modifié franckb74 vendredi 2 octobre 2015 21:27
    vendredi 2 octobre 2015 21:26
  • Bonjour,

    Pour pouvoir utiliser les objets Outlook dans Access, vous devez référencer la bibliothèque Microsoft Office Outlook xx.x ou xx.x représente la version d'Office (15.0 par exemple pour Office 2013).

    Voici comment procéder pour ajouter une référence:

    Dans l'éditeur Visual Basic, cliquez sur le menu Outils puis Références.
    Choisissez ensuite la référence que vous voulez ajouter et validez.


    En espérant avoir pu rendre service (MehdiH)
    Retrouvez moi sur Office Users

    dimanche 4 octobre 2015 07:36
  • Bonjour, Oui je sais comment ajouter un active x mais ce que je ne sais pas c'est quel active x activer en sachant que j'utilise office 2010 Pourriez-vous me donner le nom de cet active x ? En vous remerciant par avance 😀 Franck

    Franck

    dimanche 4 octobre 2015 15:19
  • Bonjour Franck,

    Pas d'activeX à ajouter juste la référence à la bibliothèque Microsoft Outlook 12.0

    Donc après avoir afficher, Sous l'éditeur VB, la boite de dialogue "Références" (Outils > Références)

    Parcourez la liste "Références disponibles" jusqu'à "Microsoft Outlook 12.0 Object Library" puis cochez la case.

    Les seuls contrôles que j'ai utilisé dans un formulaire vierge sont déjà cité plus haut:

    • Deux zones de texte et un bouton de commande.

    Je viens de mettre sur OneDrive une version de la base de données, essayez de la télécharger à partir de ce lien : https://onedrive.live.com/redir?resid=5DB53E5F364EEF3C%2110495


    En espérant avoir pu rendre service (MehdiH)
    Retrouvez moi sur Office Users

    dimanche 4 octobre 2015 15:46
  • Bonjour Mehdi, Merci beaucoup pour la base exemple ! Par contre je souhaite utiliser la liste des contacts d'une requête pour n'envoyer qu'un seul email à tous les contacts et non pas un email pour chaque contact Quel serait le code ? Merci pour votre aide ! Franck

    Franck

    dimanche 4 octobre 2015 21:35
  • Bonjour,

    J'ai quelque peu adapté le code pour répondre à votre attente.

    Remarque importante : pour la majorité des fournisseurs de services de messagerie, il y a une limite sur le nombre de destinataires simultanés (pour un seul email) à ne pas dépasser ainsi que le nombre d'emails à envoyer par heure ou par jour donc faites attention au risque de voir votre compte email bloqué.

    Private Sub cmdSend_Click()
        
        'Macro créée par Mehdi HAMMADI le 30/09/2015
        'Objet : Automation Outlook pour l'envois de courriel en utilisant comme source des adrsses électronique une requête
        'Macro inspirée du code disponible à cette adresse : http://www.blueclaw-db.com/access_email_send_outlook.htm
        
        'Macro modifiée le 05/10/2015 envois d'un seul email à tous les destinateire (mettre tous les adresses électroniques dans le champs À: en un seul bloc)
        
        'Ne pas oublier d'ajouter une référence à la bibliothèque d'objets Microsoft Outlook xx.x
    
        'Déclaration des variables
        Dim rstCourriels As DAO.Recordset
        Dim appOutlook As Outlook.Application
        Dim MailOutlook As Outlook.MailItem
        'Ajout de la variable pour la liste des destinataires
        Dim strReceipts As String
        
        'Baser le recordset sur la requête "Liste publimailing"
        Set rstCourriels = CurrentDb.OpenRecordset("Liste publimailing")
    
        'Aller au premier enregistrement du recordset
        rstCourriels.MoveFirst
        i = 1
        
        'boucler jusqu'à la fin du recordset
        Do While Not rstCourriels.EOF
            
            'Si le champ "Courriel" n'est pas vide l'ajouter à la liste des destinataires
            If Not IsNull(rstCourriels!Courriel) Then
                If i = 1 Then
                    strReceipts = rstCourriels!Courriel
                    i = 2
                Else
                    strReceipts = strReceipts & ";" & rstCourriels!Courriel
                End If
            End If
            rstCourriels.MoveNext
        Loop
        
        'Lancer Outlook si l'application n'est pas déjà ouverte
        Set appOutlook = GetObject(, "Outlook.Application")
        If Err <> 0 Then
            Set appOutlook = CreateObject("Outlook.Application")
        End If
        
        'Créer un nouvel Email
        Set MailOutlook = appOutlook.CreateItem(olMailItem)
        
        With MailOutlook
            
            'Affecter l'adresse électronique
            .To = strReceipts
            
            'Affecter l'objet du message
            .Subject = txtObjet
            
            'Affecter le corp du message
            .Body = txtMessage
            
            'Définir les options d'envoi
            .ReadReceiptRequested = False:  'Ne pas demander d'accuser de lecture
            .OriginatorDeliveryReportRequested = True:  'Demander un accusé de réception
            .Importance = olImportanceLow:  'Définir l'importance à faible
            
            'Envoyer le message
            .Send
            
        End With
        
        'Fermer le recordset
        rstCourriels.Close
        
        'Message d'information
        MsgBox "Les messages ont été créés, vérifier au niveau d'Outlook", vbApplicationModal + vbInformation + vbOKOnly, "Envois de messages"
        
        'Décharger les objets en mémoire
        Set MailOutlook = Nothing
        Set appOutlook = Nothing
        Set rstCourriels = Nothing
        
    End Sub

    Merci de penser à marquer la bonne réponse et à voter pour les réponses intéressantes ou utiles.


    En espérant avoir pu rendre service (MehdiH)
    Retrouvez moi sur Office Users


    • Modifié Mehdi HAMMADI lundi 5 octobre 2015 17:41 ajout
    • Proposé comme réponse Oliv- jeudi 8 octobre 2015 08:11
    lundi 5 octobre 2015 17:36
  • Bonjour M. Mehdi, 

    avant tout propos un grand merci pour le grand boulot que vous faites ! j'ai repris votre code dans mon application et je puis vous assurer que cela marche à 90%. Le seul bemol est que lorque je lance l'envoi de mail, il ne prend en compte qu'une dizaine de contact sur la liste de distribution qui est basée sur une requête. 

    Je me suis rassuré auprès de mon service IT pour qu'il n'y ait pas de restriction sur mon compte. je précise que j'utilise Office 2013. Pourriez vous m'indiquez là où j'ai commis l'erreur ?

    mardi 2 janvier 2018 15:04
  • Bonjour,

    De prime à bord, le problème ne semble pas venir du code ni de la version d'Office car il fonctionne déjà pour 10 adresses. La seule chose à propos de la version 2013 c'est que vous devez faire référence à la bibliothèque Outlook de la version 2013 c'est à dire "Microsoft Outlook 15.0 Object Library"

    Avez-vous vérifié que toutes les adresses de messageries sont correctes ? Il se pourrait que la 11ème adresse ne soit pas correcte et que le code cesse tout simplement de fonctionner même si normalement vous devriez avoir un message d'erreur.

    Supprimez les 10 adresses qui ont correctement fonctionnées puis relancer le code pour voir s'il crée 10 nouveaux email.

    Mettez en place une sous-routine de gestion des erreurs qui permettrait d'afficher le code de l'erreur puis de passer à l'instruction suivante.

    Sinon exécutez le code pas à pas jusqu'au 10ème message puis en passant au 11ème voir ce qui se passe.


    En espérant avoir pu rendre service (MehdiH)
    Retrouvez moi sur Office Users

    mardi 2 janvier 2018 21:08
  • bonjour M. Mehdi,

    comme vous l'avez indiqué, j'ai suivi vos conseils en activant la bibliothèque Outlook de la version 2013 et j'ai aussi vérifié l'orthographe de toutes les adresses mails mais le problème persiste. pouvez vous m'indiqué comment mettre en place un sous-routine de gestion d'erreur

    mercredi 10 janvier 2018 10:23
  • Bonjour

    Ci-après implantation du code, le problème persiste, essayez de supprimer les 10 emails qui fonctionnes puis recommencez l'opération. Ci-cela bloc, c'est probablement à cause des emails. Par contre, si cela fonctionne puis qu'au bout de 10 emails cela bloc ça risque d'être plus délicat.

    Private Sub cmdSend_Click()
        
        'Macro créée par Mehdi HAMMADI le 30/09/2015
        'Objet : Automation Outlook pour l'envois de courriel en utilisant comme source des adrsses électronique une requête
        'Macro inspirée du code disponible à cette adresse : http://www.blueclaw-db.com/access_email_send_outlook.htm
        
        'Macro modifiée le 05/10/2015 envois d'un seul email à tous les destinateire (mettre tous les adresses électroniques dans le champs À: en un seul bloc)
        
        'Ne pas oublier d'ajouter une référence à la bibliothèque d'objets Microsoft Outlook xx.x
    
        'Déclaration des variables
        Dim rstCourriels As DAO.Recordset
        Dim appOutlook As Outlook.Application
        Dim MailOutlook As Outlook.MailItem
        'Ajout de la variable pour la liste des destinataires
        Dim strReceipts As String
        
        On Error GoTo GestErr
        
        'Baser le recordset sur la requête "Liste publimailing"
        Set rstCourriels = CurrentDb.OpenRecordset("Liste publimailing")
    
        'Aller au premier enregistrement du recordset
        rstCourriels.MoveFirst
        i = 1
        
        'boucler jusqu'à la fin du recordset
        Do While Not rstCourriels.EOF
            
            'Si le champ "Courriel" n'est pas vide l'ajouter à la liste des destinataires
            If Not IsNull(rstCourriels!Courriel) Then
                If i = 1 Then
                    strReceipts = rstCourriels!Courriel
                    i = 2
                Else
                    strReceipts = strReceipts & ";" & rstCourriels!Courriel
                End If
            End If
            rstCourriels.MoveNext
        Loop
        
        'Lancer Outlook si l'application n'est pas déjà ouverte
        Set appOutlook = GetObject(, "Outlook.Application")
        If Err <> 0 Then
            Set appOutlook = CreateObject("Outlook.Application")
        End If
        
        'Créer un nouvel Email
        Set MailOutlook = appOutlook.CreateItem(olMailItem)
        
        With MailOutlook
            
            'Affecter l'adresse électronique
            .To = strReceipts
            
            'Affecter l'objet du message
            .Subject = txtObjet
            
            'Affecter le corp du message
            .Body = txtMessage
            
            'Définir les options d'envoi
            .ReadReceiptRequested = False:  'Ne pas demander d'accuser de lecture
            .OriginatorDeliveryReportRequested = True:  'Demander un accusé de réception
            .Importance = olImportanceLow:  'Définir l'importance à faible
            
            'Envoyer le message
            .Send
            
        End With
        
        'Fermer le recordset
        rstCourriels.Close
        
        'Message d'information
        MsgBox "Les messages ont été créés, vérifier au niveau d'Outlook", vbApplicationModal + vbInformation + vbOKOnly, "Envois de messages"
        
        'Décharger les objets en mémoire
        Set MailOutlook = Nothing
        Set appOutlook = Nothing
        Set rstCourriels = Nothing
        
        Exit Sub
        
    GestErr:
        MsgBox "Une erreur c'est produite" & vbCrLf & "Code de l'erreur : " & Err.Number _
        & "Description : " & Err.Description, vbCritical + vbOKOnly, "Erreur publipostage"
        Resume Next
        
    End Sub


    En espérant avoir pu rendre service (MehdiH)
    Retrouvez moi sur Office Users


    mercredi 10 janvier 2018 11:12
  • bonjour M. Mehdi,

    j'ai mis en place le sous-routine de gestion d'erreur. Effectivement il y a un problème dans mon code tels qu'indiqué dans les captures ci-dessous. j'ai fait une erreur quelques part en adaptant votre code à mon application

    Pouvez-vous m'indiquer comment resoudre le problème ?

    jeudi 11 janvier 2018 09:38
  • voici mon code adapté

    Private Sub SendEmail_Click()
        'Macro créée par Mehdi HAMMADI le 30/09/2015
        'Objet : Automation Outlook pour l'envois de courriel en utilisant comme source des adrsses électronique une requête
        'Macro inspirée du code disponible à cette adresse : http://www.blueclaw-db.com/access_email_send_outlook.htm
        
        'Ne pas oublier d'ajouter une référence à la bibliothèque d'objets Microsoft Outlook xx.x
    
        'Déclaration des variables
        Dim rstEmails As DAO.Recordset
        Dim appOutlook As Outlook.Application
        Dim MailOutlook As Outlook.MailItem
        'Ajout de la variable pour la liste des destinataires
        Dim strReceipts As String
        
        On Error GoTo GestErr
        
        'Basé le recordset sur la requête "Qry Recall"
        Set rstEmails = CurrentDb.OpenRecordset("Qry Recall")
        
        'Aller au premier enregistrement
        rstEmails.MoveFirst
        
        i = 1
        
        'boucler jusqu'à la fin du recordset
        Do While Not rstEmails.EOF
            
            'Si le champ "Courriel" n'est pas vide l'ajouter à la liste des destinataires
            If Not IsNull(rstEmails!Email) Then
                If i = 1 Then
                    strReceipts = rstEmails!Email
                    i = 2
                Else
                    strReceipts = strReceipts & ";" & rstEmails!Email
                End If
            End If
            rstEmails.MoveNext
        Loop
            
            'Lancer Outlook si l'application n'est pas déjà ouverte
        Set appOutlook = GetObject("Outlook.Application")
        If Err <> 0 Then
            Set appOutlook = CreateObject("Outlook.Application")
        End If
        
        'Créer un nouvel Email
        Set MailOutlook = appOutlook.CreateItem(olMailItem)
            
            With MailOutlook
                
                'Affecter l'adresse électronique
                .To = strReceipts
        
                'Affecter l'objet du message
                .Subject = "Vehicle Pass Expired : " & rstEmails![Registration] & "  " & rstEmails![Plant No]
                
                'Affecter le corp du message
                .Body = "Hi,Your Vehicle Pass has expired! Please go to the security's department to renew it. The registration is : " & rstEmails![Registration] & "  " & rstEmails![Plant No]
                
                'Envoyer le message
                .Send
            
            End With
    
        
        'Fermet le record set
        rstEmails.Close
        
        'Message d'information
        MsgBox "An information mail was sent to the various departments concerned", vbApplicationModal + vbInformation + vbOKOnly, "Envois de messages"
        
        'Décharger les objets en mémoire
        Set MailOutlook = Nothing
        Set appOutlook = Nothing
        Set rstEmails = Nothing
        
         Exit Sub
        
    GestErr:
        MsgBox "Une erreur c'est produite" & vbCrLf & "Code de l'erreur : " & Err.Number _
        & "Description : " & Err.Description, vbCritical + vbOKOnly, "Erreur publipostage"
        Resume Next
    End Sub
    
    €?À*DA€?::€?˜<;€?ÀEDÈA€?ÿÿÿÿ.aé.aé.ái.áiÿÿÿÿ˜<;::@4€?€?€?€ÞC€@€?:(¯!9€?€u?é=€?ÆÆÆÿ@€@€?ÿÿÿÿ.aé.aé.ái.áiÆÆÆÿÿÿÿÿÀÆÆÿ@4€?€?€?€ßC€@€?ÆÆÆÿÆÆÆÿÆÆÆÿ(¯!9€?àu?é=€?`C€@€?ÿÿÿÿ.aé.aé.ái.áiÿÿÿÿ@4€?€?€?À'D€@€?ÆÆÆÿÆÆÆÿ:(¯!9€?v?é=€?ÆÆÆÿ@€@€?ÿÿÿÿ.aé.aé.ái.áiÿÿÿÿ@4€?€?€?€ÞCA€?:‘;Ì8€?€u?€í=€?@˜A€?ÿÿÿÿ.aé.aé.ái.áiÿÿÿÿ@4€?€?€?€ßCA€?ÆÆÆÿÆÆÿÆÆÆÿÆÆÆÿ‘;Ì8€?àu?€í=€?ÆÆÆÿÄÆÆÿ`C˜A€?ÿÿÿÿ.aé.aé.ái.áiÿÿÿÿ@4ÆÆÿ€?€?€?À'DA€?ÆÆÆÿ:‘;Ì8€?v?€í=€?@˜A€?ÿÿÿÿ.aé.aé.ái.áiÿÿÿÿ@4€?€?€?€ÞCØA€?:(¯!9€?€u?ú=€?@@€?ÿÿÿÿ.aé.aé.ái.ái

    jeudi 11 janvier 2018 09:41
  • Bonjour Youssef,

    Je viens de parcourir votre code est il semble correcte.

    Que donne l'exécution pas à pas du code ?

    Pour info, je ne vois pas de capture d'écran ni aucune indication sur le numéro de l'erreur et sa description.


    En espérant avoir pu rendre service (MehdiH)
    Retrouvez moi sur Office Users

    jeudi 11 janvier 2018 11:15
  • Désolé je n'arrive pas à télécharger les captures dans le forum,

    mais voici ce qu'indique les messages d'erreurs:

    1- "Une erreur s'est produite Code de l'erreur: -2147221020Description: Automation Invalid Syntax'

    2- "Une erreur s'est produite Code de l'erreur: 91Description: object variable or With block variable not set"

    3- "Une erreur s'est produite Code de l'erreur: 3021Description: No current record"

    jeudi 11 janvier 2018 14:45
  • Bonjour,

    Pour les deux premières erreurs, debugger le code en réalisant une exécution pas à pas (F8). Ceci permettra de les repérer.

    La dernière erreur indique qu'il n'y à pas d'enregistrement donc assurez-vous que la requête que vous utilisée contient bien des enregistrements (commencez par la).


    En espérant avoir pu rendre service (MehdiH)
    Retrouvez moi sur Office Users

    dimanche 14 janvier 2018 10:18
  • bonjour M. Mehdi,

    encore une fois merci pour votre sollicitude. Je commence à voir d'oû provient l'erreur, j'ai repris le code comme ci-dessous:

    Private Sub SendEmail_Click()
        'Macro créée par Mehdi HAMMADI le 30/09/2015
        'Objet : Automation Outlook pour l'envois de courriel en utilisant comme source des adrsses électronique une requête
        'Macro inspirée du code disponible à cette adresse : http://www.blueclaw-db.com/access_email_send_outlook.htm
        
        'Ne pas oublier d'ajouter une référence à la bibliothèque d'objets Microsoft Outlook xx.x
    
        'Déclaration des variables
            Dim rstEmail As DAO.Recordset
            Set appOutLook = CreateObject("Outlook.Application")
            Set MailOutLook = appOutLook.CreateItem(olMailItem)
            
            On Error GoTo GestErr
        
        'Basé le recordset sur la requête "Qry Recall"
        Set rstEmail = CurrentDb.OpenRecordset("Qry Recall")
        
        'Aller au premier enregistrement
        rstEmail.MoveFirst
        
        'boucler jusqu'à la fin du recordset
        Do While Not rstEmail.EOF
        
            'Si le champ "Email" est vide passer à l'enregistrement suivant
            If IsNull(rstEmail!Email) Then GoTo saut_enregistrement
            
            'Définition de l'objet appliaction Outlook
            Set appOutLook = CreateObject("Outlook.application")
            'Créer un nouvel Email
            Set MailOutLook = appOutLook.CreateItem(olMailItem)
            
            With MailOutLook
                
                'Affecter l'adresse électronique
                .To = rstEmail!Email
        
                'Affecter l'objet du message
                .Subject = "Vehicle Pass Expired : " & rstEmail![Registration] & "  " & rstEmail![Plant No]
                
                'Affecter le corp du message
                .Body = "Hi,Your Vehicle Pass has expired! Please go to the security's department to renew it. The registration is : " & rstEmail![Registration] & "  " & rstEmail![Plant No]
                
                'Envoyer le message
                .Send
            
            End With
    
    saut_enregistrement:
            'Passer à l'enregistrement suivant
            rstEmail.MoveNext
        Loop
        
        'Fermet le record set
        rstEmail.Close
        
        'Message d'information
        MsgBox "An information mail was sent to the various departments concerned", vbApplicationModal + vbInformation + vbOKOnly, "Envois de messages"
        
        'Décharger les objets en mémoire
        Set MailOutLook = Nothing
        Set appOutLook = Nothing
        Set rstEmail = Nothing
        
        Exit Sub
        
    GestErr:
        MsgBox "Une erreur c'est produite" & vbCrLf & "Code de l'erreur : " & Err.Number _
        & "Description : " & Err.Description, vbCritical + vbOKOnly, "Erreur publipostage"
        Resume Next
        
    End Sub
    

    Et le message d'erreur cette fois-ci est:

    "Une erreur s'est produite. Code de l'erreur : -2147467259Description : Outlook does not recognize one or more names."

    Mais cette fois tous les mails sont envoyés malgrés le message d'erreur. Et je pense que l'erreur provient du rstEmail![Registration], VBA ne reconnait pas cette variable.


    lundi 15 janvier 2018 10:47
  • Bonsoir Youssef,

    Il me semble plutôt que l'une des adresses mail dans votre enregistrement n'est pas correcte.

    Comme il y a la routine de gestion des erreurs à chaque fois qu'une adresse mail erronée se présentera il va simplement l'ignorer et passer à l'enregistrement suivant.

    Est ce que le message d'erreur s'affiche à plusieurs reprises ?

    Complétez (modifiez) la sous-routine de gestion des erreurs comme suit:

    GestErr:
        MsgBox "Une erreur c'est produite" & vbCrLf & "Code de l'erreur : " & Err.Number _
        & "Description : " & Err.Description, vbCritical + vbOKOnly, "Erreur publipostage"
        Debug.print "Email à vérifier : " & rstEmail!Email 
        Resume Next

    Chaque email qui pose problème devrait s'afficher dans la fenêtre d'exécution. Faites une vérification de chaque adresse.


    En espérant avoir pu rendre service (MehdiH)
    Retrouvez moi sur Office Users

    lundi 15 janvier 2018 18:08
  • bonjour M. Mehdi,

    j'ai modifié la sous-routine comme vous l'avez conseillé mais la gestion d'erreur ne detecte aucune anomalie dans les adresses mails. Par contre le même message d'erreur s'affiche deux fois de suite, mais tous les mails sont envoyés à la liste de ma requête. En quelques sortes, mon probléme est resolu mais reste juste à definir la source du message d'erreur. 


    mardi 16 janvier 2018 10:42
  • Bonjour Youssef,

    Désolé mais la je suit à cours de suggestion.

    La bonne nouvelle c'est que tous vos emails partent :)


    En espérant avoir pu rendre service (MehdiH)
    Retrouvez moi sur Office Users

    mardi 16 janvier 2018 14:16
  • Mille fois merci pour votre disponibilité! je suis arrivé à ce resultat grâce à votre code initial qui m'a été d'un soutien très capital. je me contenterai de ça pour l'instant, car il a accomplit dejà ma tâche!

    A très bientôt!

    mardi 16 janvier 2018 15:32
  • Bonjour,
    Je suis directeur d'une association. Nous avions l'habitude de travailler avec une base Access pour gérer nos contacts mais la gestion des groupes vers Outlook était complexe et l'introduction d'ordinateurs sous macOS dans notre parc a rendu cela encore plus difficile.
    Nous cherchons donc une solution qui nous permette une entrée multicritère et/ou par onglets, pour un même contact pouvant avoir plusieurs fonctions, de faire des tri multicritères pour sélectionner les contacts.
    Il nous faut une solution directement connectable à outlook pour ne pas avoir à extraire des listes de destinataires à chaque envoi.
    Un autre enjeu est de pouvoir répercuter automatiquement toute modification d'une fiche contact dans l'ensemble des groupes d'envoi auquel appartient ce contact.
    Pouvez-vous m'indiquer comment répondre à ces attentes ?
    Bien cordialement

    samedi 13 avril 2019 11:22
  • Bonjour Mehdi,

    J'ai mis en place le code comme vous le donnez et il fonctionne correctement, mais dés que je met un critère dans la requête, j'ai un message d'erreur 3061 : trop de peu de paramètres .

    Pourriez vous m'orienter, je ne suis pas pro du code.

    Merci.

    vendredi 7 février 2020 15:44
  • Bonjour CHDIM,

    En me référent à quelques articles sur le web, il deux possibilités.

    Bonne continuation


    En espérant avoir pu rendre service (MehdiH)
    Retrouvez moi sur Office Users

    samedi 8 février 2020 07:16
  • Bonjour Mehdih, en faite cela fonctionne super bien quand je ne met pas de critère à la requête. Je pense en faite que c'est parce que je n'ai pas créer celle ci par le biais du module ( car je ne le maitrise pas, à part faire des copier coller de bonnes âmes comme toi ;)   ) J'ai créer une requête toute faite comme access  les proposes en "préconçues". je ne sais pas si je m'exprime correctement, et si c'est le cas, y a t'il un moyen de contourner cette erreur. Merci d'avance.

    Le débogueur me surligne cette ligne:

    Set rstCourriels = CurrentDb.OpenRecordset("Liste publipostage")

    Mais comme je vous l'ai écris ci dessus, si je ne met pas de critère, ça fonctionne correctement. 

    • Modifié CHDIM samedi 8 février 2020 14:48
    samedi 8 février 2020 14:26
  • Et c'est quoi le code de votre requête quand vous ajouter des critères.

    Je vous invite à lire cet article (en anglais) ainsi que les liens qui y figurent. Vous devriez y trouver la solution à votre problème. https://www.devhut.net/2011/11/07/ms-access-vba-run-parameter-query-in-vba/


    En espérant avoir pu rendre service (MehdiH)
    Retrouvez moi sur Office Users


    dimanche 9 février 2020 06:32
  • Bonjour , le problème doit bien venir du code que voici :

    SELECT [Compte de plots sur chantier].Etat, [Compte de plots sur chantier].[Ville de la pose], [Compte de plots sur chantier].[Adresse de la pose], [Compte de plots sur chantier].N°, [Compte de plots sur chantier].Courriel, [Compte de plots sur chantier].[Numéro de chantier]
    FROM [Compte de plots sur chantier]
    WHERE ((([Compte de plots sur chantier].N°)=[Formulaires]![Table principale]![N°]));

    Si quelqu'un peut me le traduire en VBA ?

    Merci d'avance.

    jeudi 2 avril 2020 15:23