XL 2016 Signature mail outlook avec VBA

Philou0607

XLDnaute Nouveau
Bonjour,
Je souhaiterais pouvoir insérer mon attache de signature à la fin de mon message (colonne E). Elle a été créée dans Outlook et se nomme MaSignature.
Comment et où puis je l'insérer dans le code joint svp ?
Merci bcp par avance
Philippe

Sub EnvoiMailCertifHS()
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("EnvoiMailCertifHS")
Dim i As Integer

Dim OA As Object
Dim msg As Object


Set OA = CreateObject("outlook.application")

Dim last_row As Integer
last_row = Application.CountA(sh.Range("A:A"))

For i = 2 To last_row
If sh.Range("L" & i).Value <> "NON" Then
Set msg = OA.CreateItem(0)
msg.To = sh.Range("A" & i).Value
msg.CC = sh.Range("B" & i).Value
msg.BCC = sh.Range("C" & i).Value
msg.Subject = sh.Range("D" & i).Value
msg.Body = sh.Range("E" & i).Value


If sh.Range("F" & i).Value <> "" Then
msg.Attachments.Add sh.Range("F" & i).Value
End If
If sh.Range("G" & i).Value <> "" Then
msg.Attachments.Add sh.Range("G" & i).Value
End If
If sh.Range("H" & i).Value <> "" Then
msg.Attachments.Add sh.Range("H" & i).Value
End If
If sh.Range("I" & i).Value <> "" Then
msg.Attachments.Add sh.Range("I" & i).Value
End If
If sh.Range("J" & i).Value <> "" Then
msg.Attachments.Add sh.Range("J" & i).Value
End If
If sh.Range("K" & i).Value <> "" Then
msg.Attachments.Add sh.Range("K" & i).Value
End If
msg.Send
sh.Range("L" & i).Value = "Envoyé"
End If
Next i
MsgBox "Messages Envoyés"

End Sub
Sub EffacerD()
Range("D2:D100").ClearContents
End Sub
Sub EffacerE()
Range("E2:E100").ClearContents
End Sub
Sub EffacerF()
Range("F2:F100").ClearContents
End Sub
Sub EffacerG()
Range("G2:G100").ClearContents
End Sub
Sub EffacerH()
Range("H2:H100").ClearContents
End Sub
Sub EffacerI()
Range("I2:I100").ClearContents
End Sub
Sub EffacerJ()
Range("J2:J100").ClearContents
End Sub
Sub EffacerK()
Range("K2:K100").ClearContents
End Sub
Sub EffacerL()
Range("L2:L100").ClearContents
End Sub
Sub EffacerM()
Range("M2:M100").ClearContents
End Sub

Sub Fichier()
Dim file_path As String
file_path = Application.GetOpenFilename(MultiSelect:=False)
If file_path <> "False" Then
Selection.Value = file_path
End If
End Sub
 

Pièces jointes

  • Envoi_Mails_Groupés_CertifHS.xlsm
    65.3 KB · Affichages: 1

Statistiques des forums

Discussions
312 196
Messages
2 086 101
Membres
103 116
dernier inscrit
kutobi87