Sub AttachActiveSheetPDF() Dim IsCreated As Boolean Dim i As Long Dim PdfFile As String, Title As String Dim OutlApp As Object ' Not sure for what the Title is Title = Range("A1") ' Define PDF filename PdfFile = "Sharp_Air_Estimate" i = InStrRev(PdfFile, ".") If i > 1 Then PdfFile = Left(PdfFile, i - 1) PdfFile = PdfFile & "_" & ActiveSheet.Range("C1") & ".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 = ActiveSheet.Range("C4") ' <-- Put email of the recipient here .Body = "Hi," & vbLf & vbLf _ & "Your Price estimate is attached in PDF format. Should you not be able to open the document please contact us Immediately" & vbLf & vbLf _ & "Regards," & vbLf _ & Application.UserName & vbLf & vbLf .Attachments.Add PdfFile ' Try to send On Error Resume Next .Display Application.Visible = True If Err Then MsgBox "E-mail was not sent", vbExclamation Else MsgBox "E-mail Prepared Successfully", 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
Run-time error '-2147024894 (80070002)':
Cannot find this file. Verify the path and file name are correct
When I debug it highlights .Attachments.Add PdfFile
Values in C1 = FirstName LastName
Values in A1 = Customer Name:
Values in C4 = Email address
Any assistance will be greatly appreciated.
Also if anyone knows how to have it only print page 1 to PDF that would also be an added bonus to the assistance.