Basically i need to save the data on sheet 2 as a PDF and then attach that PDF to an email and send. I want to see the email before sending.
The name of the file is predefined with the data that is publicised in a cell after another macro is run.
The working code i have managed to mangle together is as follows; and this attaches the pdf to an email i just need some code that works to save the file in a pre created folder and as the same pdf file name as the email attachment. but im struggling. I have managed to save the pdf but then i cant attach to an email.
Sub AttachActiveSheetPDF()
Dim IsCreated As Boolean
Dim i As Long
Dim PdfFile As String, Title As String
Dim OutlApp As Object
Sheets("Sheet2").Activate
' Not sure cell the Title is in so change if needed
Title = Range("C19")
' Define PDF filename
PdfFile = ActiveWorkbook.FullName
i = InStrRev(PdfFile, ".")
If i > 1 Then PdfFile = Left(PdfFile, i - 1)
PdfFile = PdfFile & "_" & Title & ".pdf"
' Export activesheet as PDF
With ActiveSheet
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End With
' Use already open Outlook if possible
On Error Resume Next
Set OutlApp = GetObject(, "Outlook.Application")
If Err Then
Set OutlApp = CreateObject("Outlook.Application")
IsCreated = True
End If
OutlApp.Visible = True
On Error GoTo 0
' Prepare e-mail with PDF attachment
With OutlApp.CreateItem(0)
' Prepare e-mail
.Subject = Title
.To = "...." ' <-- Put email of the recipient here
.CC = "...." ' <-- Put email of 'copy to' recipient here
.Body = "Please see attached," & vbLf & vbLf _
& "Regards." & vbLf & vbLf _
& "" & vbLf _
& " " & vbLf & vbLf
.Attachments.Add PdfFile
' Try to send
On Error Resume Next
.display
Application.Visible = True
If Err Then
MsgBox "E-mail failure open outlook", vbExclamation
Else
MsgBox "E-mail ready to send", vbInformation
End If
On Error GoTo 0
End With
' Delete PDF file
Kill PdfFile
' Quit Outlook if it was created by this code
If IsCreated Then OutlApp.Quit
' Release the memory of object variable
Set OutlApp = Nothing
Sheets("Sheet1").Activate
End Sub
any help greatly received.
Thanks
Aaron
Bookmarks