Envoyer un mail via OUTLOOK de Excel

Version imprimable

17/01/2022, 15h26
Christian_Pfender

Envoyer un mail via OUTLOOK de Excel

Bonjour à tous,

Mes meilleurs vœux pour cette nouvelle année

je vous remercie d'avance pour toute votre aide.

Je voudrais générer un mail à partir d'Excel avec les données d'entrée suivantes :

Dans la colonne C se trouve un numéro de local
Dans la colonne D se trouve une date de début de prestation
Dans la colonne I se trouve l'adresse mail du destinataire

A partir de ces éléments, j'aimerais que 15 jours avant la date indiqué en colonne D un mail soit envoyé à la personne mentionnée en colonne I avec un message que je ne n'ai pas encore rédigé mais qui prévient mon client de notre intervention (valeur en colonne D)
Dans ce mail, je voudrais récupérer le pdf lié à la valeur de la colonne C pour envoi (fiche d'identification du local)
Le PDF en question est stocké dans un dossier du bureau (même dossier que mon fichier excel)

J'espère avoir été assez précis dans mon explication

Merci pour votre aide :help:
17/01/2022, 16h59
Jean-Philippe André

Bonjour,

chacune des étapes peut effectivement être prise en charge par une ou plusieurs instructions VBA.

Sur quelle(s) partie(s) du code as-tu déjà commencé des choses ? quel est le soucis sur lequel tu butes actuellement ?

Nous pouvons t'aider à progresser, mais pas te fournir du code tout fait, tu t'en doutes bien :)

Bonjour Jean-Philippe,

J'ai effectivement commencé à écrire un bout de code pour le mailing
Maintenant je bloque sur l'intégration de la PJ et la mise en forme du texte d'information dans le corps de mail
Voici déjà ce que j'ai écris (désolé étant novice il y aura surement des incohérences :D) mais pour l'avoir testé le mail est envoyé

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
Sub SendMail()
Dim strTo As String
Dim strSubject As String
Dim strBody As String
Dim MyTab As ListObject
Dim LR As ListRow
Dim MsgSent As Integer
Dim MsgFailed As Integer
 
MsgSent = 0
MsgFailed = 0
Set MyTab = Sheet1.ListObjects(1)
 
For Each LR In MyTab.ListRows
    If LR.Range(4) >= Date - 15 Or LR.Range(4) = "FAUX" Then
        strTo = LR.Range(9)
        strSubject = "Local n°" & LR.Range(2)
        strBody = "Bonjour,Dans le cadre de notre campagne , vous recevez aujourd'hui ce mail pour une échéance à venir.Merci de libérer au maximum le sol de votre local pour nous permettre une intervention efficace."
 
        If SendActiveWorkbook(strTo, strSubject, , strBody) = True Then
 
             MsgSent = MsgSent + 1
        Else
           MsgFailed = MsgFailed + 1
        End If
    End If
Next LR
 
If MsgFailed = 0 Then
    MsgBox ("Vous avez envoyé " & MsgSent & " mails")
Else
    MsgBox ("Vous avez envoyé " & MsgSent & " mails." & MsgFailed & " messages n'ont pas pu etre remis")
End If
End Sub
 
 
Function SendActiveWorkbook(strTo As String, strSubject As String, Optional strCC As String, Optional strBody As String) As Boolean
On Error Resume Next
Dim appOutlook As Object
Dim mItem As Object
SendActiveWorkbook = False
On Error GoTo fin
Set appOutlook = CreateObject("Outlook.Application")
Set mItem = appOutlook.CreateItem(0)
 
With mItem
    .To = strTo
    .CC = strCC
    .Subject = strSubject
    .Body = strBody
    .Send
End With
 
Set mItem = Nothing
Set appOutlook = Nothing
SendActiveWorkbook = True
fin:
End Function

Merci pour l'aide :ccool:

17/01/2022, 17h53
Christian_Pfender

Alors j'ai encore avancé sur le texte dans le corps de mail
J'ai inséré le code " & vbLf & " pour passer à la ligne

Comment peut-on dans ce corps de texte insérer la date qui se trouve en colonne D

Ensuite restera le sujet intégration du fichier pdf dans le mail
19/01/2022, 08h43
halaster08

Bonjour,

Regarde la discussion ci-dessous:
https://www.developpez.net/forums/d1...ur-gras-corps/

J'utilise des plages nommés pour récupérer des infos du fichier Excel mais tu peux très bien utiliser des cellules normales
Et pour la mise en forme on m'avait conseillé le html
19/01/2022, 11h58
Christian_Pfender

Citation:

Envoyé par halaster08

Bonjour,

Regarde la discussion ci-dessous:
https://www.developpez.net/forums/d1...ur-gras-corps/

J'utilise des plages nommés pour récupérer des infos du fichier Excel mais tu peux très bien utiliser des cellules normales
Et pour la mise en forme on m'avait conseillé le html

Bonjour Halaster08,

Je recherche surtout à ce que dans la partie strBody je puisse intégrer le numéro de local qui est mentionné en colonne C
Ce que je recherche est que dans le corps de mail apparaisse :
"Bonjour,
Dans le cadre de notre campagne , vous recevez aujourd'hui ce mail pour une échéance à venir pour le local "mentionné en colonne C".
L'intervention sera prévue pour "valeur de la colonne D"

Ensuite je souhaiterai qu'avant que le mail parte, je puisse y intégrer un pdf
Actuellement, l'envoi se fait instantanément et je n'ai pas la possibilité d'insérer une PJ (le cas échéant un pdf)

Si tu as une piste 8O

Merci
19/01/2022, 13h31
halaster08

Citation:

Envoyé par Christian_Pfender

Je recherche surtout à ce que dans la partie strBody je puisse intégrer le numéro de local qui est mentionné en colonne C

Il faut écrire ton strbody en plusieurs fois et insérer tes valeurs grace l'opérateur de concaténation &

Code:

strbody = " bonjour ..." & worksheets("mafeuille").range("c1").value & "la suite de la phrase" & worksheets("mafeuille").range("d1").value & "..."

Citation:

Envoyé par halaster08

Il faut écrire ton strbody en plusieurs fois et insérer tes valeurs grace l'opérateur de concaténation &

Code:

strbody = " bonjour ..." & worksheets("mafeuille").range("c1").value & "la suite de la phrase" & worksheets("mafeuille").range("d1").value & "..."

J'ai essayé d'intégré comme indiqué le bout de code que tu m'as suggéré mais j'ai un code erreur

J'ai essayé de rentrer un code pour la PJ : idem un code erreur au niveau de la ligne

Code:

.Attachments.Add (strFolder & "\" & MaPJ)

Voici le récap de ce que j'ai déjà écris :

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
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
Sub SendMail()
Dim strTo As String
Dim strSubject As String
Dim strBody As String
Dim MyTab As ListObject
Dim LR As ListRow
Dim MsgSent As Integer
Dim MsgFailed As Integer
 
MsgSent = 0
MsgFailed = 0
Set MyTab = Sheet1.ListObjects(1)
 
For Each LR In MyTab.ListRows
    If LR.Range(4) >= Date - 15 Or LR.Range(4) = "FAUX" Then
        strTo = LR.Range(9)
        strSubject = "Local n°" & LR.Range(2)
        strBody = "Bonjour," & vbLf & "" & vbLf & "Dans le cadre de notre campagne de nettoyage des moquettes du Cargo Terminal, vous recevez aujourd'hui ce mail pour une échéance à venir concernant le local" & vbLf & "Merci de libérer au maximum le sol de votre local pour nous permettre une intervention efficace." & vbLf & "" & vbLf & "Vous trouverez en PJ les tâches sur la moquette qui avaient été répertoriées comme non traitable." & vbLf & "" & vbLf & "La date prévisionnelle d'intervention sera le"
        If SendActiveWorkbook(strTo, strSubject, , strBody) = True Then
 
             MsgSent = MsgSent + 1
        Else
           MsgFailed = MsgFailed + 1
 
 
 
                   'Ajout d 'une PJ
        Dim MaPJ
 
        Dim strFolder As String, WshShell, leFichier
        Set WshShell = CreateObject("WScript.Shell")
        strFolder = WshShell.SpecialFolders("Desktop")
 
        MaPJ = "NouvelFiche.zip"
        'on verifie d'abord qu'il existe.
        If Dir(strFolder & "\" & MaPJ) <> "" Then
            '.Attachments.Add MaPJ  "NouvelFiche.zip"
            .Attachments.Add (strFolder & "\" & MaPJ)
        Else
            MsgBox "Fichier : " & MaPJ & vbCr & "Non trouvée sur:" & vbCr & strFolder, vbCritical
            .display
            'on affiche le mail et fin
            End
        End If
        'ajout ar lecture
        .ReadReceiptRequested = True
 
        'envoi au nom de
         .SentOnBehalfOfName = Worksheets("FR").Range("J13")
 
        'Soit je l'affiche
        'Display
        'Soit je l'envoi
        .Send
    End With
 
 
        End If
    End If
Next LR
 
If MsgFailed = 0 Then
    MsgBox ("Vous avez envoyé " & MsgSent & " mails")
Else
    MsgBox ("Vous avez envoyé " & MsgSent & " mails." & MsgFailed & " messages n'ont pas pu etre remis")
End If
 
End Sub
 
 
Function SendActiveWorkbook(strTo As String, strSubject As String, Optional strCC As String, Optional strBody As String) As Boolean
On Error Resume Next
Dim appOutlook As Object
Dim mItem As Object
SendActiveWorkbook = False
On Error GoTo fin
Set appOutlook = CreateObject("Outlook.Application")
Set mItem = appOutlook.CreateItem(0)
 
With mItem
    .To = strTo
    .CC = strCC
    .Subject = strSubject
    .Body = strBody
    .Send
End With
 
Set mItem = Nothing
Set appOutlook = Nothing
SendActiveWorkbook = True
fin:
End Function

Please Help :help:

19/01/2022, 15h28
halaster08

Essaye sans les parenthèses

Code:

.Attachments.Add (strFolder & "\" & MaPJ)
20/01/2022, 11h49
Christian_Pfender

Citation:

Envoyé par halaster08

Essaye sans les parenthèses

Code:

.Attachments.Add (strFolder & "\" & MaPJ)

J'ai essayé en enlevant les "" mais "référence incorrecte ou non qualifiée" sur le .attachment

Je sèche complètement là

8O
20/01/2022, 11h51
Christian_Pfender

Citation:

Envoyé par Jean-Philippe André

Bonjour,

chacune des étapes peut effectivement être prise en charge par une ou plusieurs instructions VBA.

Sur quelle(s) partie(s) du code as-tu déjà commencé des choses ? quel est le soucis sur lequel tu butes actuellement ?

Nous pouvons t'aider à progresser, mais pas te fournir du code tout fait, tu t'en doutes bien :)

Bonjour Jean-Phillipe,

J'ai avancé sur le sujet mais là je bloque

Une petite aide please

Merci
20/01/2022, 14h25
Jean-Philippe André

Salut,

Il n'est pas nécessaire d'ajouter les parenthèses pour ton ajout de pièce jointe :

Code:

.Attachments.Add (strFolder & "\" & MaPJ)

devient donc

Code:

.Attachments.Add strFolder & "\" & MaPJ

Je t'invite à reprendre le code proposé dans la :faq: et enrichi ici
https://www.developpez.net/forums/d9...omplement-faq/

J'ai bien retiré les () mais toujours "référence incorrecte ou non qualifiée" sur le .attachment

Je vous remets le code en 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
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
Sub SendMail()
Dim strTo As String
Dim strSubject As String
Dim strBody As String
Dim MyTab As ListObject
Dim LR As ListRow
Dim MsgSent As Integer
Dim MsgFailed As Integer
 
MsgSent = 0
MsgFailed = 0
Set MyTab = Sheet1.ListObjects(1)
 
For Each LR In MyTab.ListRows
    If LR.Range(4) >= Date - 15 Or LR.Range(4) = "FAUX" Then
        strTo = LR.Range(9)
        strSubject = "Local n°" & LR.Range(2)
        strBody = "Bonjour," & vbLf & "" & vbLf & "Dans le cadre de notre campagne de nettoyage des moquettes du Cargo Terminal, vous recevez aujourd'hui ce mail pour une échéance à venir concernant le local" & vbLf & "Merci de libérer au maximum le sol de votre local pour nous permettre une intervention efficace." & vbLf & "" & vbLf & "Vous trouverez en PJ les tâches sur la moquette qui avaient été répertoriées comme non traitable." & vbLf & "" & vbLf & "La date prévisionnelle d'intervention sera le"
        If SendActiveWorkbook(strTo, strSubject, , strBody) = True Then
 
 
Dim MaPJ
 
        Dim strFolder As String, WshShell, leFichier
        Set WshShell = CreateObject("WScript.Shell")
        strFolder = WshShell.SpecialFolders("Desktop")
 
        MaPJ = "NouvelFiche.zip"
        'on verifie d'abord qu'il existe.
        If Dir(strFolder & "\" & MaPJ) <> "" Then
            '.Attachments.Add MaPJ  "NouvelFiche.zip"
            .Attachments.Add strFolder & "\" & MaPJ
        Else
            MsgBox "Fichier : " & MaPJ & vbCr & "Non trouvée sur:" & vbCr & strFolder, vbCritical
            .display
            'on affiche le mail et fin
            End
        End If
        'ajout ar lecture
        .ReadReceiptRequested = True
 
        'envoi au nom de
         .SentOnBehalfOfName = Worksheets("FR").Range("J13")
 
        'Soit je l'affiche
        'Display
        'Soit je l'envoi
        .Send
    End With
 
 
 
             MsgSent = MsgSent + 1
        Else
           MsgFailed = MsgFailed + 1
 
 
 
 
 
        End If
    End If
Next LR
 
If MsgFailed = 0 Then
    MsgBox ("Vous avez envoyé " & MsgSent & " mails")
Else
    MsgBox ("Vous avez envoyé " & MsgSent & " mails." & MsgFailed & " messages n'ont pas pu etre remis")
End If
 
End Sub
 
 
Function SendActiveWorkbook(strTo As String, strSubject As String, Optional strCC As String, Optional strBody As String) As Boolean
On Error Resume Next
Dim appOutlook As Object
Dim mItem As Object
SendActiveWorkbook = False
On Error GoTo fin
Set appOutlook = CreateObject("Outlook.Application")
Set mItem = appOutlook.CreateItem(0)
 
With mItem
    .To = strTo
    .CC = strCC
    .Subject = strSubject
    .Body = strBody
    .Send
End With
 
Set mItem = Nothing
Set appOutlook = Nothing
SendActiveWorkbook = True
fin:
End Function

:arf::arf::arf::arf::arf::arf:

20/01/2022, 16h02
Jean-Philippe André

où est ton With ?
24/01/2022, 15h02
Pierre Fauconnier

Salut

Comme l'a spécifié Jean-Philippe, La ligne .Attachements.Add doit se trouver dans un bloc With... End With, ainsi que la ligne .Display. Or, il n'y a pas de bloc With... End With dans ta procédure, pas plus d'ailleurs qu'un objet de type Outlook.MailItem.

De plus, le code montré semble envoyer le classeur Excel actif, alors que ce n'est apparemment pas ce qui était exprimé dans la demande initiale. Du coup, on s'y perd un peu. Peut-être devrais-tu reformuler avec précision ce que tu souhaites réaliser, sans code et sans jargon VBA, comme si tu rédigeais un cahier des charges.
24/01/2022, 16h30
Christian_Pfender

Citation:

Envoyé par Pierre Fauconnier

Salut

Comme l'a spécifié Jean-Philippe, La ligne .Attachements.Add doit se trouver dans un bloc With... End With, ainsi que la ligne .Display. Or, il n'y a pas de bloc With... End With dans ta procédure, pas plus d'ailleurs qu'un objet de type Outlook.MailItem.

De plus, le code montré semble envoyer le classeur Excel actif, alors que ce n'est apparemment pas ce qui était exprimé dans la demande initiale. Du coup, on s'y perd un peu. Peut-être devrais-tu reformuler avec précision ce que tu souhaites réaliser, sans code et sans jargon VBA, comme si tu rédigeais un cahier des charges.

Effectivement je vais reprendre ma demande initiale sans rien omettre

Alors j'ai un fichier dans lequel j'ai :

- un onglet "Planification 2022" dans lequel :

en colonne C j'ai une liste de locaux
en colonne D j'ai une date de début d'intervention sur le local en question
en colonne I j'ai l'adresse mail pour le local concerné

- ensuite j'ai des onglets que j'ai nommé avec le numéro de local de la colonne C (la trame de chaque onglet est identique mais le contenu diffère)

Ce que j'essaie d'écrire en VBA :

Etape 1 : enregistrer en pdf l'onglet actif dans le même dossier que le fichier (j'avais écris une macro avec un msgbox pour cette étape qui me positionne sur l'onglet et l'enregistre dans le dossier
)

Etape 2 : Envoyer un mail au client qui figure en colonne I à J-15 par rapport à la date qui figure en colonne D en incluant en PJ la fiche PDF que j'aurai créé pour le local mentionné en colonne C
et qui porte le même nom

Par ex, le local n° 10000 (colonne C) intervention prévue le 31/01/22 (colonne D), il faudrait envoyer un mail au client colonne I avec la pièce jointe (PDF du local 10000) à J-15

J'espère que c'est plus clair et encore merci pour votre temps et aide précieuse