VBA : E-mail avec PDF joint automatique

Sub MailEnvoi()
' Working in Office 2000-2010
Dim OutApp As Object
Dim OutMail As Object
Dim WrdApp As Object

With Application
.EnableEvents = False
.ScreenUpdating = False
End With

Set OutApp = CreateObject("Outlook.Application")

If Worksheets("CBF").Range("E17").Value Like "?*@?*.?*" Then
Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail
.To = Worksheets("CBF").Range("E17").Value
.CC = "test@mail.com; test2@mail.com"
.BCC = ""
.Subject = Range("P5").Value
.Body = GetBoiler("adresse d'un fichier txt sur un serveur partagé")
.Display
End With
On Error GoTo 0

Set OutMail = Nothing
End If

Set OutApp = Nothing
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub


Function GetBoiler(ByVal sFile As String) As String
'Dick Kusleika
Dim fso As Object
Dim ts As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
GetBoiler = ts.readall
ts.Close
End Function

Cliquez pour agrandir...