Create pdf and label

[Jeffro2p]

HI,
I am using the following code to create a pdf from and excel sheet.
I want the name of the cell to be the contents of D15.
Haven't used macros for over a year and I am very rusty.
[code]
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 = 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 = Title
.To = "[email protected]"
.Body = "Hi," & vbLf & vbLf _
& "The report is attached in PDF format. Can you please contact me for assistance." & vbLf & vbLf _
& "Regards," & 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

' 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
[code/]

[davesexcel]

You can edit your original post to add code tags.

AA CodeTags.jpg

[IonutC]

HI,

You want to name the pdf with the info from the cell D15?

[Jeffro2p]

Sorry for slow response.
Yes, want to label document according to what they put into D15