How to convert to PDR and Send versus attaching whole workbook **PLEASE HELP**

[PariyahDesign]

I have a workbook that consists of 3 worksheets. Right now the way I have the code set in the workbook people push a button and an email is created that dumps in the entire workbook. Well now this workbook needs to go out to multiple people at the same time so I've put those emails into the BCC of the code. I no longer want the code to go along with the book because if users go into the code they could see all of the emails.

Simple solution, I want to only send the first worksheet which is called "Request for Quote". I'd like to convert it to a PDF and send only that sheet. Here's the code I currently use. How to I change this to now convert to PDF and send??

Please help. I need to get this project out to a lot of people. Most of the code I want to leave in tact if I can because it's pulling data elements out of the worksheet to fill in subjects and the body of the email. All I need is to change this to convert and email as a PDF.

Private Sub Air_Click()

End Sub

Private Sub EMailNippon_Click()
Dim iReply As Integer
    iReply = MsgBox(Prompt:="Do you want to send this request for quote?", _
            Buttons:=vbYesNo, Title:="Send")
    If iReply = vbYes Then
        Call TestOutlookIsOpen
    ElseIf iReply = vbNo Then
        Exit Sub
    End If
End Sub
Public Sub TestOutlookIsOpen()
    Dim oOutlook As Object

    On Error Resume Next
    Set oOutlook = GetObject(, "Outlook.Application")
    On Error GoTo 0

    If oOutlook Is Nothing Then
        MsgBox "Microsoft Outlook is not open.  Please open Outlook and try again."
    Else
        'Call NameOfYourMailMacro
        Call ToSendEmail
        Call Mail_workbook_Outlook_2
    End If
End Sub
Sub Mail_workbook_Outlook_2()
'Working in Excel 2000-2013
'Mail a copy of the ActiveWorkbook with another file name
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
    Dim wb1 As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim FileExtStr As String
    Dim OutApp As Object
    Dim OutMail As Object

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    Set wb1 = ActiveWorkbook

    'Make a copy of the file/Open it/Mail it/Delete it
    'If you want to change the file name then change only TempFileName
    TempFilePath = Environ$("temp") & "\"
    TempFileName = "Copy of " & wb1.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")
    FileExtStr = "." & LCase(Right(wb1.Name, Len(wb1.Name) - InStrRev(wb1.Name, ".", , 1)))

    wb1.SaveCopyAs TempFilePath & TempFileName & FileExtStr

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next
    With OutMail
        .To = ""
        .CC = "firstname.lastname@email.com"
        .BCC = "firstname.lastname@email.com;firstname.lastname@email.com"
        'E-MAIL SUBJECT WORDING
        .Subject = "Request For Freight Quote - Proj# " & Range("ProjNo").Value & "," & " Customer: " & _
        Range("CustID").Value & " - Response Needed By " & Range("ResponseDate")
        'E-MAIL BODY WORDING & ATTACHMENT
        .Body = "Please provide a detailed freight quote based on the information contained in the attached file." _
        & vbCrLf & "Let me know if you have any questions or need additional information.  Thank you!" _
        & vbCrLf _
        & vbCrLf & "Best Regards," _
        & vbCrLf & Range("RequestorName").Value _
        & vbCrLf & "Phone: " & Range("RequestorPhone").Value _
        & vbCrLf & Range("ReturnQuoteEmail").Value _
        & vbCrLf
        .Importance = olImportanceNormal 'Or olImprotanceHigh Or olImprotanceLow
        .Attachments.Add TempFilePath & TempFileName & FileExtStr
        .ReadReceiptRequested = False
        'You can add other files also like this
        '.Attachments.Add ("C:\test.txt")
        .Display   'or use .Send
    End With
    On Error GoTo 0

    'Delete the file
    Kill TempFilePath & TempFileName & FileExtStr

    Set OutMail = Nothing
    Set OutApp = Nothing

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
    'Call EmailHasBeenSent
End Sub

Public Sub ToSendEmail()
     MsgBox "When Microsoft Outlook opens, please amend your e-mail with any needed additional text, and add any additional contacts that this e-mail should be sent to.  Then, press the SEND button."
End Sub
Public Sub EmailHasBeenSent()
     MsgBox "Your e-mail request for quote has been sent.  You will receive a copy of the e-mail that has been sent."
End Sub
Private Sub Truck_Click()

End Sub

Private Sub TextBox1_Change()

End Sub

Private Sub TEST1Email()
    Dim OL              As Object
    Dim EmailItem       As Object
    Dim Wb              As Workbook
     
    Application.ScreenUpdating = False
    Set OL = CreateObject("Outlook.Application")
    Set EmailItem = OL.CreateItem(olMailItem)
    Set Wb = ActiveWorkbook
    Wb.Save
    With EmailItem
        .Subject = "Insert Subject Here"
        .Body = "Insert message here" & vbCrLf & _
        "Line 2" & vbCrLf & _
        "Line 3"
        .To = "adam.doherty@tmeic.com"
        .Importance = olImportanceNormal 'Or olImprotanceHigh Or olImprotanceLow
        .Attachments.Add Wb.FullName
        .Send
    End With
     
    Application.ScreenUpdating = True
     
    Set Wb = Nothing
    Set OL = Nothing
    Set EmailItem = Nothing
   

End Sub


Private Sub TruckLTL_Click()

End Sub

 

[PariyahDesign]

Correction on my TITLE....Should read PDF!