Envoyer un message via CDO ACCESS VBA

Résolu
brunohampert Messages postés 11 Date d'inscription dimanche 12 octobre 2003 Statut Membre Dernière intervention 28 octobre 2021 - Modifié le 27 oct. 2021 à 19:01
brunohampert Messages postés 11 Date d'inscription dimanche 12 octobre 2003 Statut Membre Dernière intervention 28 octobre 2021 -
Bonjour,

J'ai trouvé un code que j'ai adapté à mes besoins.
Lorsque je l'exécute, le premier mail à une pice jointe, le deuxième mail à deux pièces jointes ...
Je ne touve pas où ça coince.
Quelqu'un peut-il m'aider svp? 

Public Function send_email()
Dim Rst_Mail As DAO.Recordset
Dim Emetteur As String
Dim Serveur As String
Dim Port As Integer
Dim MDP As String
Dim Fichier As String
Dim strHtml As String  'variable contenu du corps de message

' Ouvre la ligne des caractéristiques du mailling dans la table "T_RECAPITULATIF"
Set Rst_Mail = CurrentDb.OpenRecordset("select * from T_RECAPITULATIF where Num_Jour = " & ChoixJour)
' récupère le serveur d'émission dans la table paramètres
Serveur = DLookup("SMTP", "parametres", Variable = SMTP)
' récupère le port smtp dans la table paramètres
Port = DLookup("Port", "parametres", Variable = Port)
' récupère le nom de l'émetteur dans la table paramètres
Emetteur = DLookup("Emetteur", "parametres", Variable = Emetteur)
' récupère le mot de passe dans la table paramètres
MDP = DLookup("MDP", "parametres", Variable = MDP)



  Set cdomsg = CreateObject("CDO.message")
  With cdomsg.Configuration.Fields
    .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 'NTLM method
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = Serveur
    .Item("http://schemas.microsoft.com/cdo/configuration/smptserverport") = Port
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
    .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = Emetteur
    .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = MDP
    .Update
  End With
  ' build email parts
  
  strHtml = "<HTML><HEAD><BODY><p>" & Bjr & "</p>"
            strHtml = strHtml & "<p>" & TxtBody1 & "</p>"
            strHtml = strHtml & "<br>" & TxtBody2 & "</br>"
            strHtml = strHtml & "<br>" & TxtBody3 & "</br>"
            strHtml = strHtml & "<br></br>" & Politesse & "<br></br><br></br>"
            strHtml = strHtml & "<p align='center'>" & Signature_1 & "</p></body><HTML>"
            strHtml = strHtml & "<p align='center'>" & Signature_2 & "</p></body><HTML>"
            strHtml = strHtml & "<p align='center'>" & Signature_3 & "</p></body><HTML>"
            strHtml = strHtml & "</BODY></HEAD></HTML>"
  
  If Not (Rst_Mail.EOF And Rst_Mail.BOF) Then
    
    Do Until Rst_Mail.EOF = True
        On Error Resume Next
        Fichier = Application.CurrentProject.Path & "\Récapitulatif panier N° " & Rst_Mail("Num_Panier") & " - " & Rst_Mail("NOM") & " " & Rst_Mail("PRENOM") & ".pdf"
        DoCmd.OpenReport "E_RECAPITULATIF", acViewReport, , "[Num_Panier]= " & Rst_Mail("Num_Panier")
        DoCmd.OutputTo acOutputReport, "", acFormatPDF, Fichier
        DoCmd.Close acReport, "E_RECAPITULATIF"
        DoEvents
    With cdomsg
        .To = Rst_Mail("MAIL")
        .From = Emetteur
        .Subject = "Recapitulatif panier N° " & Rst_Mail("Num_Panier") & " - " & Rst_Mail("NOM") & " " & Rst_Mail("PRENOM")
        .HTMLBody = strHtml
        .AddAttachment Fichier
        .Send
        
    End With
    Rst_Mail.MoveNext
    Kill Fichier
    Loop
    
    Set cdomsg = Nothing
  End If
 End Function


D'avance merci

Bruno

--
A voir également:

2 réponses

Réponse 1 / 2
yg_be Messages postés 23541 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 6 juin 2025 Ambassadeur 1 584
28 oct. 2021 à 09:13
bonjour,
quand tu partages du code VBA, peux-tu préciser "basic" dans les balises de code?
0
brunohampert Messages postés 11 Date d'inscription dimanche 12 octobre 2003 Statut Membre Dernière intervention 28 octobre 2021
28 oct. 2021 à 16:39
Ok, désolé
0
Réponse 2 / 2
yg_be Messages postés 23541 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 6 juin 2025 Ambassadeur 1 584
28 oct. 2021 à 09:17
Le plus simple, je pense, est d'ajouter une ligne 
.Attachments.DeleteAll

avant 
.AddAttachment Fichier
0
brunohampert Messages postés 11 Date d'inscription dimanche 12 octobre 2003 Statut Membre Dernière intervention 28 octobre 2021
28 oct. 2021 à 16:42
Nickel, ça fonctionne.

Merci beaucoup
0

Discussions similaires

Echec d'envoi message sur Messenger
Kris68 -
Colibri -

Bonsoir à tous,

J’ai une question à vous poser, comment ça se fais quand je veux envoyer un message sur Messenger ça me dit échec de l’envoie, vous ne pourrez pas temporairement effectuer cette action. Quelqu’un saurait par hasard pourquoi ?

Merci bonne soirée.

2 réponses
impossible d envoyer message a un contact sans être bloquée
vic -
bazfile -

Bonjour, quand j essaie envoyer un message à un contact je recois, un point d exclamation jaune avec "impossible d envoyer" Ce contact ne m a pas bloqué et ma connexion est bonne car j arrive a envoyer des messages a d autres amis.. Pourquoi je ne peux lui envoyer de message alors que la personne ne m a pas bloquée; MERCI

1 réponse
SMS message vocal arnaque ?
kikidefer -
brucine -

Bonjour
j'ai reçu ce matin un sms me disant que j'avais un message vocal d'un 07
et que je dois cliquer sur le lien dans le sms pour l'écouter.

Je pense que c'est une arnaque mais sa commence par un 07 donc j'hésite...

quel est votre avis?

Cordialement

9 réponses
Envoie impossible messenger
LynaMorgana -
Kuroni -

Donc depuis un certain moment sur mon iPhone XR a chaque fois que j’essaie d’envoyer un message vocal sur messenger un rond rouge avec un point d’exclamation dedans s’affiche à côté du message vocal. Si je clique sur le message vocal dessous il y a écrit envoi impossible. Je ne comprend pas. Je ne peux plus envoyer de message vocal à personne.

1 réponse