Worksheet > PDF > Auto Email - Code is throwing new error

[sanantonio]

Hi All,

Inherited this code from a colleague who's no longer with the business. Has always worked in the workbook he left it in. And I've successfully ported it to other workbooks in the past.

However in this latest workbook I'm importing it into I get an error on the ".Attachments.Add PdfFile" line. Name of the PDF is Range "Q2" which in this case is simply "test".

I'm convinced it's gotta be something to do with the title but like I say it's always worked in the past? Would appreciate it if anyone could help

Sub email()
'
' email Macro
'
If MsgBox("This will automatically generate and send the PDF tab via email, are you sure you wish to proceed?", vbYesNo) = vbNo Then Exit Sub


  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("Q2")
 
  ' Define PDF filename
  PdfFile = Range("Q2")
  i = InStrRev(PdfFile, ".")
  If i > 1 Then PdfFile = Left(PdfFile, i - 1)
  PdfFile = PdfFile & ".pdf"
 
  ' Export activesheet as PDF
  With Worksheets("PDF")
    .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 = "colleague@xx.com" ' <-- Put email of the recipient here separated by a semi-colon
    .CC = "colleague@xx.com" ' <-- Put email of 'copy to' recipient here
    .Body = "Hi," & vbLf & vbLf _
          & "Please find attached latest Events Validation Report. You will receive this report the first Friday of every month. Should you no longer wish to receive it please reply to the original sender ONLY. If you would like anyone person included on this email please reply to the original sender ONLY." & vbLf & vbLf _
          & "Regards AD Team" & vbLf _
          & Application.UserName & vbLf & vbLf
    .Attachments.Add PdfFile
   
    ' Try to send
    On Error Resume Next
    .Send
    Application.Visible = True
    If Err Then
      MsgBox "E-mail was not sent", vbExclamation
    Else
      MsgBox "E-mail successfully sent", vbInformation
    End If
    On Error GoTo 0
   
  End With
 
 On Error Resume Next
 
  ' Delete PDF file
  Kill PdfFile
  
  On Error Resume Next
 
  ' 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

 

[sanantonio]

  ' Define PDF filename
  PdfFile = Range("Q2")
  i = InStrRev(PdfFile, ".")
  If i > 1 Then PdfFile = Left(PdfFile, i - 1)
  PdfFile = PdfFile & ".pdf"

Tiny update. The code works when the above is replaced with:

  ' Define PDF filename
  PdfFile = ActiveWorkbook.FullName
  i = InStrRev(PdfFile, ".")
  If i > 1 Then PdfFile = Left(PdfFile, i - 1)
  PdfFile = PdfFile & "_" & ".pdf"

How can I define the PDF's name to a cell reference and still have the attaching process work?