Envoyer un message via CDO ACCESS VBA
Résolu
brunohampert
Messages postés
11
Date d'inscription
Statut
Membre
Dernière intervention
-
brunohampert Messages postés 11 Date d'inscription Statut Membre Dernière intervention -
brunohampert Messages postés 11 Date d'inscription Statut Membre Dernière intervention -
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?
D'avance merci
Bruno
--
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:
- Envoyer un message via CDO ACCESS VBA
- Comment recuperer un message supprimé sur whatsapp - Guide
- Epingler un message whatsapp - Accueil - Messagerie instantanée
- Message supprimé whatsapp - Guide
- Envoyer un message vocal - Guide
- Message absence thunderbird - Guide
2 réponses
yg_be
Messages postés
23541
Date d'inscription
Statut
Contributeur
Dernière intervention
Ambassadeur
1 584
bonjour,
quand tu partages du code VBA, peux-tu préciser "basic" dans les balises de code?
quand tu partages du code VBA, peux-tu préciser "basic" dans les balises de code?
brunohampert
Messages postés
11
Date d'inscription
Statut
Membre
Dernière intervention
Ok, désolé
yg_be
Messages postés
23541
Date d'inscription
Statut
Contributeur
Dernière intervention
Ambassadeur
1 584
Le plus simple, je pense, est d'ajouter une ligne
avant
.Attachments.DeleteAll
avant
.AddAttachment Fichier