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
| Sub Send()
'
Dim strPath As String, strFName As String
Dim OutApp As Object, OutMail As Object
strPath = Environ$("temp") & "\"
strFName = ActiveWorkbook.Name
strFName = Left(strFName, InStrRev(strFName, ".") - 1) & "_" & ActiveSheet.Name & ".pdf"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
strPath & strFName, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.to = "apc.equifac@proximus.com"
.CC = ""
.BCC = ""
.Subject = "Equifac"
.Body = "" & vbCr & "" & vbCr
.Attachments.Add strPath & strFName
.Display
End With
Kill strPath & strFName
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub |
Partager