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("D2100").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
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("D2100").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