Création mail avec Pièce jointe ET signature par défaut

**byloute** · 27/06/2019, 18h33

Bonjour,

A la base, mon code me permet de créer mon mail avec une pièce jointe sans intégrer la signature par défaut d'outlook (alors que je veux la signature).
Je me suis dit qu'il manquait quelque chose... et en cherchant je tombe sur le code plus bas, qui affiche la signature par défaut sans que je ne l'a précise.

Du coup, est-ce que dans mon code (le premier) il y a un paramètre qui interdit la reprise de la signature ? (vu que dans le second elle s'affiche sans que je l'a précise)

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
Dim appOutlook As Outlook.Application
    Set appOutlook = Outlook.Application
    Dim MESSAGE As Outlook.MailItem
    Dim objRecipient As Outlook.Recipient
 
    Set MESSAGE = appOutlook.CreateItem(olMailItem)
    With MESSAGE
        .Subject = "[Création] " & ActiveCell.Value
 
        ' Corps en HTML
        .BodyFormat = olFormatHTML
        .HTMLBody = "<html><body> <font face=""calibri""><p>Bonjour,</p><p>Test.</p>"
 
        ' Destinataire principal
        Set objRecipient = .Recipients.Add("Test@free.fr")
        objRecipient.Type = olTo    'olBCC, olCC, olOriginator ou olTo.
        objRecipient.Resolve
 
        ' Destinataire en copie
        Set objRecipient = .Recipients.Add(CP_Dest_copie)
        objRecipient.Type = olCC    'olBCC, olCC, olOriginator ou olTo.
        objRecipient.Resolve
        '
        'Ajout d 'une PJ
        Dim PJ
        PJ = Rep_Projet & "\[Création] " & ActiveCell.Value & ".xlsx"
        'on verifie d'abord qu'elle existe.
        If Dir(PJ) <> "" Then
            .Attachments.Add PJ
        End If
 
        'ajout AR lecture
        .ReadReceiptRequested = False
 
        'Afficher le mail
        .Display
        'Envoyer le mail automatiquement
        '.Send

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
Sub Mail_Outlook_With_Signature_Html_1()
' Working in Office 2000-2016
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String
 
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
 
    strbody = "<H3><B>Dear Customer Ron de Bruin</B></H3>" & _
              "Please visit this website to download the new version.<br>" & _
              "Let me know if you have problems.<br>" & _
              "<A HREF=""http://www.rondebruin.nl/tips.htm"">Ron's Excel Page</A>" & _
              "<br><br><B>Thank you</B>"
 
    On Error Resume Next
 
    With OutMail
        .Display
        .To = "ron@debruin.nl"
        .CC = ""
        .BCC = ""
        .Subject = "This is the Subject line"
        .HTMLBody = strbody & "<br>" & .HTMLBody
        .Send
    End With
 
    On Error GoTo 0
    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

Merci d'avance,