Sending PDF with Outlook email

[zplugger]

Have to working code that sends a workbook as PDF with outlook mail.I have a address book that it gets the name and email address from,problem is if
the person is not in address book I have problems. Is there a way to have a input box pop up to insert a email address if its not in main address book? Really
need to expert advice on this,not even sure if it can be done.
Thanks Z

Const rootpath = "C:\Builder\master\temp"
Const CoName = "Bob's the Builder-"

Dim vinv As String
Dim vbuilder As String
Dim vjob As String
 Dim vSaveAs As String

Sub PackageAndSend()
    SaveAsPDF
    Send_Files
     On Error Resume Next
    Kill vSaveAs 'Deletes the PDF file'
End Sub

Sub SaveAsPDF()

    Const OpenPDF = False
    vinv = CleanseString(Range("invoiceone"))
    vbuilder = CleanseString(Range("builder"))
    vjob = CleanseString(Range("C13"))

    vSaveAs = rootpath & "\" & CoName & vinv & "-" & vbuilder & "-" & vjob & ".pdf"

    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
                                    vSaveAs, _
                                    Quality:=xlQualityStandard, _
                                    IncludeDocProperties:=True, _
                                    IgnorePrintAreas:=True, _
                                     From:=1, To:=1, _
                                    OpenAfterPublish:=OpenPDF

End Sub

Sub Send_Files()


    Dim OutApp As Object
    Dim OutMail As Object
    Dim AddBook As Worksheet
    Dim Found As Range

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

    Set AddBook = Sheets("Address Book")
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    vbuilder = Range("builderone")
   Rem Set Found = AddBook.Range("A:A").Find(What:=vbuilder, _
                                          After:=Range("A1"))

    currsht = ActiveSheet.Name
    AddBook.Activate
    Set Found = AddBook.Columns("A:A").Find(What:=vbuilder, _
                                            After:=Range("A1"), _
                                            LookIn:=xlValues, _
                                            LookAt:=xlWhole, _
                                            SearchOrder:=xlByColumns, _
                                            SearchDirection:=xlNext, _
                                            MatchCase:=False, SearchFormat:=False)

    If Not Found Is Nothing Then
        vEmailAddress = Found.Offset(0, 4)
    End If

    vBody = vbuilder & ";" & vbLf
    vBody = vBody & vbLf & vbLf
    vBody = vBody & "See the attached PDF file ." & vbLf
    vBody = vBody & "" & vbLf
    vBody = vBody & "" & vbLf
    vBody = vBody & CoName
With OutMail
    
        .To = vEmailAddress
        .Subject = CoName & "-" & vinv & "-" & vjob
        .Body = vBody

        If Dir(vSaveAs) <> "" Then
            .Attachments.Add vSaveAs
        End If
         If Trim(.To) = "" Then
        MsgBox ("Your trying to sent an Email that is not in the (AddressBook),you must (Open Outlook) and minimized it before you try and send!")
        End If
        
        If Trim(.To) = "" Then
        .send
        Else
        
        .send 'use .send or .display
        End If
    End With
    
    Sheets(currsht).Activate
    Set OutMail = Nothing
    Set OutApp = Nothing
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub

[berlan]

Hi zplugger,

without going through the whole code in detail, I think what you are asking for is to add these lines (in red):

    If Not Found Is Nothing Then
        vEmailAddress = Found.Offset(0, 4)
    Else   'if not found
        vEmailAddress = Application.InputBox("Email not found, please enter", , Type:=2)
    End If

Cheers,
berlan

[zplugger]

OMG Berlan you are a Genius, works like a champ.Will run some more test tomorrow for any other bugs.

Thanks Z

[berlan]

Glad it worked, you're welcome!

[zplugger]

Morning All
Ran some test today and found a error. Everything works good except when you cancel the input box you get error.If I try and send a email without address in addressbook the
inputbox pops up and wants a email address.This is good if I know the address,but if I'm not sure of address I want to cancel and this is what I get.I guess want I need is if
I cancel just exit the sub?

Outlook Error.PNG
Thanks Z

[Vikas_Gautam]

You can use this line of code:-

after vEmailAddress = application.inputbox

[berlan]

Another example:

If Not Found Is Nothing Then
    vEmailAddress = Found.Offset(0, 4)
Else   'if not found
    vEmailAddress = Application.InputBox("Email not found, please enter", , Type:=2)
    If vEmailAddress = False Then   'if canceled was clicked
        Call MsgBox("Canceled was clicked", 48, "")
        Exit Sub    'or add other procedure
    End If
End If

The line,

If vEmailAddress = False Then

is the same as

If Not vEmailAddress then

Cheers,
berlan

[zplugger]

Real close but after I cancel it go's to my address book sheet.I want it to stay on the sheet I was on.The sheet I sent
the email from was proposal.

[zplugger]

Got, thanks guys for all the help on this.
Z

[berlan]

You're welcome! Thanks for the kind feedback and positive rep added!