Bonjour,

J'ai une macro qui envoie des mails pour OUTLOOK à partir Excel 2007.
Cependant, celle-ci dessous envoie ces mails uniquement à partir de ma boîte aux lettres principale.

Je souhaiterais apporter une correction, pour que celle-ci puisse envoyer ces mails à partir de boites aux lettres supplémentaires ajoutées.
Ne voyant pas comment corriger cette macro, quelqu'un peut-il m'aider ?
Code : Sélectionner tout - Visualiser dans une fenêtre à part
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
 
Sub Mail_Outlook_With_Signature_Html_()
 
Ladatecalculée = IIf(Weekday(Date) = 2, Date - 3, Date - 1)
 
Select Case MsgBox("Envoyer un message ?" & vbCr & vbTab & _
"Client : ---" & vbCr & _
" " & vbCr & vbTab & _
"Tableau au " & Format(Ladatecalculée, "dd/mm/yy"), vbYesNo + vbQuestion, "Microsoft OUTLOOK : envoyer un message")
Case vbYes
 
Formulaire.Hide 'Cache/Masque le formulaire'
 
' Working in Office 2000-2016
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String
 
    Set OutApp = CreateObject("Outlook.Application") 'Lance une session Microsoft Outlook'
    Set OutMail = OutApp.CreateItem(0) 'Crée un nouveau message'
 
    'Corps du message' 'taille police 12 et Calibri'
    strbody = "<BODY style=font-size:12pt;font-family:Calibri>Bonjour,<p>Ci-joint, le tableau au " & Format(Ladatecalculée, "dd.mm.yyyy") & ".<p>Cordialement.</BODY>"
 
'_________________Début : exemple de corps de message'
'strbody = "<BODY style=font-size:12pt;font-family:Calibri>Bonjour,<p>livraison " & DateAdd("d", Date, 2) & ".<p>Bonne réception.</BODY>"
'_________________Fin : exemple de corps de message'
 
 
    On Error Resume Next
    'Si (lorsque) une erreur d'exécution se produit, VBA passe à l'instruction suivante celle ayant causé l'erreur'
 
    With OutMail
        .Display
        .To = " " 'Destinataire du message'
        .CC = " " 'En copie du message'
        .BCC = ""
        .Subject = "Test mail " & Format(Ladatecalculée, "dd/mm/yy") 'Objet du message'
        .HTMLBody = strbody & "<br>" & .HTMLBody
'Début Pièces jointes'
        .Attachments.Add " "
'ou'
            '.Attachments.Add ThisWorkbook.Path & "\" & ThisWorkbook.Name 'Pièces jointes du message : sur fichier ouvert'
'Fin Pièces jointes'
        .Send 'Envoi du message'
    End With
 
    On Error GoTo 0 'Désactive toute gestion d'erreur par une ou l'autre forme de On error"
    Set OutMail = Nothing 'Réinitialise l'objet'
    Set OutApp = Nothing 'Réinitialise l'objet'
 
Case vbNo
Exit Sub 'sortie de la macro'
End Select
End Sub
Merci d'avance pour votre aide.

Cordialement.