Email current sheet as PDF but auto insert email address, title and user customised body from cell references

J

jblonde002

Board Regular
Joined
Jun 10, 2014
Messages
61
Hi all, I am currently using this macro which I have taken from somewhere else, I am definitely not capable of creating it!)
Code: 
Sub AttachThisPLCasPDF()
  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 = ActiveWorkbook.FullName
  i = InStrRev(PdfFile, ".")
  If i > 1 Then PdfFile = Left(PdfFile, i - 1)
  PdfFile = PdfFile & "_" & ActiveSheet.Name & ".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 = "Your PLC is attached"
    .To = "Insert Student Email Address" ' <-- Put email of the recipient here
    .CC = "" ' <-- Put email of 'copy to' recipient here
    .Body = "Hi," & vbLf & vbLf _
          & "Your most up-to-date PLC is attached as a PDF." & 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 "Process Complete", 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
 
End Sub
What I would like to change is for the email address to be automatically inserted from cell F5 from the same sheet (sheet is called PLC). I would like the title of the email to come from cell B20 in a sheet called "PLC Personalisation Options" and the body of the email to come from B21 in "PLC Personalisation Options". Also, if at all possible (but I don't think it is?) I would like the PDF to be named the result of the formula in PLC cell G1. Can anyone help with this at all? Can the Macro be tweaked like that?
 

Excel Facts

Return population for a City
If you have a list of cities in A2:A100, use Data, Geography. Then =A2.Population and copy down.
Sort by date Sort by votes
Try this, UNTESTED...I don't have Excel at the moment
Note, this will only Display the E-Mail before sending.
T make it send automatically, change the line
Code: 
.Display

TO

.Send


Code: 
Sub AttachThisPLCasPDF()
  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 = ActiveWorkbook.FullName
  i = InStrRev(PdfFile, ".")
  If i > 1 Then PdfFile = Left(PdfFile, i - 1)
  PdfFile = Sheets("PLC").Range("G21").Value & ".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 = Sheets("PLC Personalisation Options").Range("B20").Value
    .To = Sheets("PLC").Range("F5").Value ' <-- Put email of the recipient here
    .CC = "" ' <-- Put email of 'copy to' recipient here
    .Body = Sheets("PLC Personalisation Options").Range("B21").Value
    .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 "Process Complete", 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
End Sub
 
Upvote 0
Code bombed on this line...
Code: 
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
Odd?
 
Upvote 0
When you manually run the code using F8....what is the value of PDfFile. try changing this line
Code: 
PdfFile = Sheets("PLC").Range("G21").Value & ".pdf"

to

Code: 
PdfFile =PdfFile & "_" &  Sheets("PLC").Range("G21").Value & ".pdf"
 
Last edited:
Upvote 0
Michael M said:
When you manually run the code using F8....what is the value of PDfFile. try changing this line
Code: 
PdfFile = Sheets("PLC").Range("G21").Value & ".pdf"

to

Code: 
PdfFile =PdfFile & "_" &  Sheets("PLC").Range("G21").Value & ".pdf"
Click to expand...
Made change above (thanks) but now it bombs on
Code: 
 .Attachments.Add PdfFile
Not sure what the problem is here?
 
Upvote 0
Works fine for me....what's the value in "PLC" Range("G21") ??

Can you repost the complete NEW code please ??
 
Upvote 0
Michael M said:
Works fine for me....what's the value in "PLC" Range("G21") ??

Can you repost the complete NEW code please ??
Click to expand...

Current code used is:
Code: 
Sub AttachThisPLCasPDFEdit()
  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 = ActiveWorkbook.FullName
  i = InStrRev(PdfFile, ".")
  If i > 1 Then PdfFile = Left(PdfFile, i - 1)
  PdfFile = PdfFile & "_" & Sheets("PLC").Range("G21").Value & ".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 = Sheets("PLC Personalisation Options").Range("B20").Value
    .To = Sheets("PLC").Range("F5").Value ' <-- Put email of the recipient here
    .CC = "" ' <-- Put email of 'copy to' recipient here
    .Body = Sheets("PLC Personalisation Options").Range("B21").Value
    .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 "Process Complete", 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
End Sub
The formula in G21 is =D2&"'s"&" "&'PLC Personalisation Options'!B4&" Progress" and the subsequent result (which is what i would like the PDF to be named) is Daniel Smith's Business Studies Progress.
 
Upvote 0
Just to be clear by the way, my last post didn't acknowledge that the email now has the title and body of B20/B21 perfectly, plus the email address from F5. The sole issue now is the PDF naming from Cell G1...
 
Upvote 0
HAng on....your last post says "G1"....shouldn't it be "G21"
Hmm, I can't fault it....it works fine for me on EXcel 2007
Can you make sure the PdfFile name is exactly as you advised.
When you step through the code line by line hover you mouse over the line PDffile =
AFTER you have stepped past it !!
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Question
Email issue with .Attachments.Add PdfFile
Replies
0
Views
289
jayserna
J
M
  • Solved
How To Make Shape Disappear After Mouse Click, then reappear after switch sheet.
Replies
6
Views
525
Artik
Artik
sanantonio
  • Solved
Where in this code it is specifying a filepath?
Replies
4
Views
496
Domenic
D
sanantonio
  • Question
Worksheet > PDF > Auto Email - Code is throwing new error
Replies
1
Views
616
sanantonio
sanantonio
T
  • Solved
Save pdf to a specific folder
Replies
7
Views
843
trevolly
T

Forum statistics

Threads
1,214,638
Messages
6,120,676
Members
448,977
Latest member
moonlight6

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top