Forum - Problèmes liés à mes codes mis à disposition - SendMail CDO

Bonjour,

Dans les deux dernières fonctions proposées, je ne vois pas comment attacher la pièce jointe

(J'espère que ma question est à la bonne place).

A plus

Pierre

Bonjour,

J'envoi mon lot de factures par mail, hélas, ce qui me gêne c(est le problème de variables dont je suis obligé de coller la valeur dans des champs du formulaire pour les récupérer ensuite en VBA.

Option Compare Database
Option Explicit

Public Destinataire As String
Public ObjetDuMessage As String
Public PièceJointe As String

'Si le serveur smtp par défaut n'est pas reconnu (clients mail non Microsoft), on pourra employer les fonctions ci-dessous.
Private Function GetSMTPServerConfig() As Object
    Dim Cdo_Config As New CDO.Configuration
    Dim Cdo_Fields As Object
    Set Cdo_Fields = Cdo_Config.Fields

    With Cdo_Fields
        .Item(cdoSendUsingMethod) = cdoSendUsingPort
        .Item(cdoSMTPServer) = DFirst("SMTP_Serveur", "T_Constantes")
        .Item(cdoSMTPServerPort) = DFirst("SMTP_Serveur_Port", "T_Constantes")
        .Update
    End With

    Set GetSMTPServerConfig = Cdo_Config
    Set Cdo_Config = Nothing
    Set Cdo_Fields = Nothing

End Function

'Syntaxe:
'Call SendMailCDO("Sender", "Destinataire", "Subject", "BodyText", "W:CheminMaFacture.pdf")
Private Function SendMailCDO(Sender As String, Destinataire, ObjetDuMessage, BodyText As String, PièceJointe)

    Dim Cdo_Message As New CDO.Message
    Set Cdo_Message.Configuration = GetSMTPServerConfig()

'Pour ces deux variables ci après pas de problème !    
Sender = DFirst("Email_Expéditeur", "T_Constantes")
BodyText = DFirst("Corps_Message", "T_Constantes")

    With Cdo_Message
        .From = Sender
        .To = Me.EmailDestinataire	'pour que ça fonctionne, le suis obligé de coller la valeur Destinataire de la variable dans un champ du formulaire 
        .Subject = Me.Objet		''pour que ça fonctionne, le suis obligé de coller la valeur ObjetDuMessage de la variable dans un champ du formulaire
        .TextBody = BodyText
        .addAttachment (Me.CheminEtPièce)	''pour que ça fonctionne, le suis obligé de coller la valeur de la variable PièceJointe dans un champ du formulaire
        .Send
    End With
    Set Cdo_Message = Nothing
End Function

Private Sub EnvoyerAvec_Click() 'par messagerie
'On utilise le Numéro de facture et non pas CléP_Facture
On Error GoTo Fin
If NbFactAvec >= 1 Then
    DoCmd.SetWarnings False
        'Purge de la table des factures à envoyer par messagerie
        DoCmd.RunSQL "Delete T_Factures_Envoi_Messagerie.CléP_Facture_Envoi_Messagerie FROM T_Factures_Envoi_Messagerie"
        'Peuplement de la table des factures à envoyer par messagerie "T_Factures_Envoi_Messagerie"
        DoCmd.OpenQuery "R_Factures_Envoi_Messagerie_PeuplementTable"
     
Dim NbFact_à_Envoyer As Integer
Dim FirstFactNuméro As Variant
'Dim Destinataire As String
'Dim PièceJointe As String
Dim qdf As DAO.QueryDef
    Set qdf = CurrentDb.QueryDefs!R_Factures_Etat

Do
    NbFact_à_Envoyer = DCount("FeM_Facture_Imprimé_PDF", "T_Factures_envoi_Messagerie", "FeM_Facture_Imprimé_PDF = 0")
    FirstFactNuméro = DMin("FeM_Facture_Numéro", "T_Factures_envoi_Messagerie", "FeM_Facture_Imprimé_PDF = 0")
        qdf.SQL = "SELECT R_Factures.*, R_Facture_Contenu.* FROM R_Factures LEFT JOIN R_Facture_Contenu " & _
        "ON R_Factures.CléP_Facture = R_Facture_Contenu.FC_Clé_Facture " & _
                    "WHERE R_Factures.Fact_Numéro = " & FirstFactNuméro
    Destinataire = DLookup("FeM_Messagerie_Destinataire", "T_Factures_Envoi_Messagerie", "FeM_Facture_Numéro = " & FirstFactNuméro)
    
    ObjetDuMessage = "Notre facture du " & DLookup("FeM_Facture_Date", "T_Factures_Envoi_Messagerie", "FeM_Facture_Numéro = " & FirstFactNuméro)
    Me.Objet = ObjetDuMessage
    Me.EmailDestinataire = Destinataire
    PièceJointe = "W:BasesIrisFacturesEnvoiMessagerie" & DLookup("FeM_PDF_Nom", "T_Factures_Envoi_Messagerie", "FeM_Facture_Numéro =" & FirstFactNuméro)
    Me.CheminEtPièce = PièceJointe
    DoCmd.RunSQL "UPDATE T_Factures_Envoi_Messagerie SET T_Factures_Envoi_Messagerie.FeM_Facture_Imprimé_PDF = -1 " & _
                    "WHERE T_Factures_Envoi_Messagerie.FeM_Facture_Numéro = " & FirstFactNuméro
                    
    'Crée le document PDF correspondant à la facture
    DoCmd.OutputTo acOutputReport, "E_Facture", "PDFFormat(*.pdf)", "W:BasesIrisFacturesEnvoiMessagerie" & DLookup("FeM_PDF_Nom", "T_Factures_Envoi_Messagerie", "FeM_Facture_Numéro =" & FirstFactNuméro), False, "", , acExportQualityScreen
    'Envoie l'Email avec la facture jointe
    Call SendMailCDO("Sender", "Destinataire", "Subject", "BodyText", "PièceJointe")

    'Met à joiur la date d'envoi de la facture
    DoCmd.RunSQL "UPDATE T_Factures SET T_Factures.Fact_Date_EnvoiMessagerie = " & Date * 1 & " WHERE T_Factures.Fact_Numéro = " & FirstFactNuméro
    Me.NbPDFEnvoyés = NbFactAvec - NbFact_à_Envoyer + 1

Loop Until NbFact_à_Envoyer = 1
     Me.Refresh
   'Vider le répertoire "W:BasesIrisFacturesEnvoiMessagerie"
    Kill "W:BasesIrisFacturesEnvoiMessagerie*.pdf"
Else
    If MsgBox("Il n'y a aucune facture sélectionnée !" & (Chr(10) & Chr(10)) & _
    "Vous devez sélectionner des factures" & Chr(10) & _
    "pour pouvoir les voir, les imprimer" & Chr(10) & _
    "ou bien les envoyer par messagerie." & Chr(10) & _
    "" & (Chr(10)), vbApplicationModal, CurrentDb.Properties("AppTitle")) = vbOK Then Exit Sub
End If
Fin:
    DoCmd.SetWarnings True
        'Remet la reqête de la facture d'origine
        qdf.SQL = "SELECT R_Factures.*, R_Facture_Contenu.* FROM R_Factures LEFT JOIN R_Facture_Contenu ON R_Factures.CléP_Facture = R_Facture_Contenu.FC_Clé_Facture"
        Set qdf = Nothing
End Sub

C'est cette partie qui me semble douteuse, je pense que je pourrais me passer de cet artifice :

Public Destinataire As String
Public ObjetDuMessage As String
Public PièceJointe As String


    ObjetDuMessage = "Notre facture du " & DLookup("FeM_Facture_Date", "T_Factures_Envoi_Messagerie", "FeM_Facture_Numéro = " & FirstFactNuméro)
    Me.Objet = ObjetDuMessage
    Me.EmailDestinataire = Destinataire
    PièceJointe = "W:BasesIrisFacturesEnvoiMessagerie" & DLookup("FeM_PDF_Nom", "T_Factures_Envoi_Messagerie", "FeM_Facture_Numéro =" & FirstFactNuméro)
    Me.CheminEtPièce = PièceJointe

    With Cdo_Message
        .From = Sender
        .To = Me.EmailDestinataire	'pour que ça fonctionne, le suis obligé de coller la valeur Destinataire de la variable dans un champ du formulaire 
        .Subject = Me.Objet		''pour que ça fonctionne, le suis obligé de coller la valeur ObjetDuMessage de la variable dans un champ du formulaire
        .TextBody = BodyText
        .addAttachment (Me.CheminEtPièce)	''pour que ça fonctionne, le suis obligé de coller la valeur de la variable PièceJointe dans un champ du formulaire
        .Send
    End With

Il doit bien y avoir une raison pour que ça ne marche pas directement avec la valeur des variables 

Peut être as tu une réponse

merci par avance

Pierre

Bonjour,

L'informatique est bien au service des utilisateurs, mais ce n'est pas pour que ceux-ci écrivent n'importe quoi en espérant que cela fonctionne tout de même !

C'est un programme bien écrit qui est au service de l'utilisateur

Des choses comme :

& Chr(10) & _

ne sont  pas à employer. Il y a une constante pour cela : vbCRLF qu'il faut employer.

Ensuite, tu déclares une variable public :

Public Destinataire As String

Pourquoi ?

Ensuite tu utilises la variable "Destinataire" comme variant dans la fonction ?

Puis, des champs ? indépendants ?  

Me.Objet

Me.Destinataire

et tu veux que cela fonctionne ?

Le code mis à disposition fonctionne, a condition de ne pas modifier sans comprendre ce que l'on fait !!

Il faudrait aussi apprendre comment on transmet des valeurs à une fonction, cela aiderait sûrement...

Cordialement,

Pierre (3Stone)

Merci pour la réponse

Private Sub EnvoyerAvec_Click() 'par messagerie
'On utilise le Numéro de facture et non pas CléP_Facture
On Error GoTo Fin
If NbFactAvec >= 1 Then
    DoCmd.SetWarnings False
        'Purge de la table des factures à envoyer par messagerie
        DoCmd.RunSQL "Delete T_Factures_Envoi_Messagerie.CléP_Facture_Envoi_Messagerie FROM T_Factures_Envoi_Messagerie"
        'Peuplement de la table des factures à envoyer par messagerie "T_Factures_Envoi_Messagerie"
        DoCmd.OpenQuery "R_Factures_Envoi_Messagerie_PeuplementTable"
     
Dim NbFact_à_Envoyer As Integer
Dim FirstFactNuméro As Variant
Dim qdf As DAO.QueryDef
    Set qdf = CurrentDb.QueryDefs!R_Factures_Etat

Dim Destinataire As String
Dim ObjetDuMessage As String
Dim PièceJointe As String
Dim Sender As String
Dim BodyText As String

    Sender = DFirst("Email_Expéditeur", "T_Constantes")

Do
    NbFact_à_Envoyer = DCount("FeM_Facture_Imprimé_PDF", "T_Factures_envoi_Messagerie", "FeM_Facture_Imprimé_PDF = 0")
    FirstFactNuméro = DMin("FeM_Facture_Numéro", "T_Factures_envoi_Messagerie", "FeM_Facture_Imprimé_PDF = 0")
        qdf.SQL = "SELECT R_Factures.*, R_Facture_Contenu.* FROM R_Factures LEFT JOIN R_Facture_Contenu " & _
        "ON R_Factures.CléP_Facture = R_Facture_Contenu.FC_Clé_Facture " & _
                    "WHERE R_Factures.Fact_Numéro = " & FirstFactNuméro
    Destinataire = DLookup("FeM_Messagerie_Destinataire", "T_Factures_Envoi_Messagerie", "FeM_Facture_Numéro = " & FirstFactNuméro)
    
    ObjetDuMessage = "Notre facture du " & DLookup("FeM_Facture_Date", "T_Factures_Envoi_Messagerie", "FeM_Facture_Numéro = " & FirstFactNuméro)
    
    BodyText = "A l'attention de " & _
                DLookup("FeM_Personne_Destinataire", "T_Factures_Envoi_Messagerie", "FeM_Facture_Numéro = " & FirstFactNuméro) & vbCrLf & vbCrLf & _
                DFirst("Corps_Message", "T_Constantes")
    
    PièceJointe = "W:BasesIrisFacturesEnvoiMessagerie" & DLookup("FeM_PDF_Nom", "T_Factures_Envoi_Messagerie", "FeM_Facture_Numéro =" & FirstFactNuméro)
    DoCmd.RunSQL "UPDATE T_Factures_Envoi_Messagerie SET T_Factures_Envoi_Messagerie.FeM_Facture_Imprimé_PDF = -1 " & _
                    "WHERE T_Factures_Envoi_Messagerie.FeM_Facture_Numéro = " & FirstFactNuméro
                    
    'Crée le document PDF correspondant à la facture
    DoCmd.OutputTo acOutputReport, "E_Facture", "PDFFormat(*.pdf)", "W:BasesIrisFacturesEnvoiMessagerie" & DLookup("FeM_PDF_Nom", "T_Factures_Envoi_Messagerie", "FeM_Facture_Numéro =" & FirstFactNuméro), False, "", , acExportQualityScreen
    'Envoie l'Email avec la facture jointe

    Dim Cdo_Message As New CDO.Message
    Set Cdo_Message.Configuration = GetSMTPServerConfig()
    
    With Cdo_Message
        .From = Sender
        .To = Destinataire
        .Subject = ObjetDuMessage
        .TextBody = BodyText
        .addAttachment (PièceJointe)
        .Send
    End With
    Set Cdo_Message = Nothing

    'Met à joiur la date d'envoi de la facture
    DoCmd.RunSQL "UPDATE T_Factures SET T_Factures.Fact_Date_EnvoiMessagerie = " & Date * 1 & " WHERE T_Factures.Fact_Numéro = " & FirstFactNuméro
    Me.NbPDFEnvoyés = NbFactAvec - NbFact_à_Envoyer + 1
Loop Until NbFact_à_Envoyer = 1

    'Vider le répertoire "W:BasesIrisFacturesEnvoiMessagerie"
    Me.Refresh
    Kill "W:BasesIrisFacturesEnvoiMessagerie*.pdf"
Else
    If MsgBox("Il n'y a aucune facture sélectionnée !" & (vbCrLf & vbCrLf) & _
    "Vous devez sélectionner des factures" & vbCrLf & _
    "pour pouvoir les voir, les imprimer" & vbCrLf & _
    "ou bien les envoyer par messagerie." & vbCrLf & _
    "" & (vbCrLf), vbApplicationModal, CurrentDb.Properties("AppTitle")) = vbOK Then Exit Sub
End If
    DoCmd.SetWarnings True
        'Remet la requête de la facture d'origine
        qdf.SQL = "SELECT R_Factures.*, R_Facture_Contenu.* FROM R_Factures LEFT JOIN R_Facture_Contenu ON R_Factures.CléP_Facture = R_Facture_Contenu.FC_Clé_Facture"
        Set qdf = Nothing
    If MsgBox("Toutes les factures sélectionnées" & vbCrLf & _
    "et dont le destinataire possède une adresse de messageie valide" & vbCrLf & _
    "ont été envoyées par messagerie Internet." & (vbCrLf), vbInformation, CurrentDb.Properties("AppTitle")) = vbOK Then Exit Sub
        
Exit Sub
Fin:
    DoCmd.SetWarnings True
        'Remet la reqête de la facture d'origine
        qdf.SQL = "SELECT R_Factures.*, R_Facture_Contenu.* FROM R_Factures LEFT JOIN R_Facture_Contenu ON R_Factures.CléP_Facture = R_Facture_Contenu.FC_Clé_Facture"
        Set qdf = Nothing
    If MsgBox("Oh ! Fan des pieds," & vbCrLf & _
    "Encore une cagatte." & vbCrLf & vbCrLf & _
    "Pour des raisons inconnues," & vbCrLf & _
    "le processus d'envoi des messages a été interrompu." & vbCrLf & vbCrLf & _
    "Vous pouvez tenter d'envoyer à nouveau les messages" & vbCrLf & _
    "mais ne selectionnez pas ceux qui ont déja une date d'envoi.", vbCritical, CurrentDb.Properties("AppTitle")) = vbOK Then Exit Sub
End Sub

J'ai pris note de tes remarques et modifié le code comme ci dessus, et ça marche très bien.

Merci pour tout, et toutes tes remarques sont les bienvenues

Pierre