Attatching an already embedded PDF to an Email.

[CBurgess]

Okay, my problem is as follows:

My "Drawing" is embedded on Sheet1, later on in Sheet12 I click a button that'll send an automatic email to a user. I want to attatch the embedded PDF onto this email if it is at all possible??

  Dim Drawing As Object

After I've declared my variables I've tried setting the variable "Drawing" to the object, this is where I'm encountering my errors mainly "Type Mismatch" or Object Variable not set...

    Sheets("Menu").Visible = True
    Drawing = Sheet1.Shapes.range(Array("Drawing"))
    Selection.Verb Verb:=xlPrimary
    Sheets("Menu").Visible = False

At the bottom of the code, this is where i pull in the object

        .To = Sheet12.range("L8")
        .CC = ""
        .BCC = ""
        .Subject = "Arrange P&D Request"
        .htmlbody = strbody & vbNewLine & Signature
        .Attachments.Add ("Drawing")

Cheers guys, you're help is appreciated.

 

[EPURON]

Okay now try this

Sub epuron()
    Dim OutApp As Object
    Dim OutMail As Object
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
'automatically saves file as a pdf
        fName = Application.GetSaveAsFilename("", "PDF Files (*.pdf), *.pdf")
        ActiveSheet.ExportAsFixedFormat xlTypePDF, fName, xlQualityStandard, , , , , True
    On Error Resume Next
   ' Change the mail address and subject in the code before you run it.
   ' sends message with attachment for outlook
    With OutMail
        .To = " 'the main email that the pdf will send to' "
        .CC = ""
        .BCC = ""
        .Subject = " 'input subject title between quotation marks "
        .Body = " 'input body message between quotation marks "
        .Attachments.Add 'insert worksheet here that the pdf is located onto'.FullName
        .Send
    End With
    On Error GoTo 0
    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

What i did was i edited the "attachments.add" so that you can send a worksheet. I'm assuming that the pdf is on a worksheet.

Make a button on each sale and set a macro for each button. Add a email that it will be sending to or more if you want. For the worksheet, for each button, set the worksheet with the pdf for each.

for ex. house 3000sq $300,000 (button)

if person wants to buy house, clicks it and sends to email. button is assigned to pdf of house information, etc.

Hope this helps!

 

[CBurgess]

Does that send the PDF on the worksheet, or just the worksheet though!

I'm sure there would be an easier way to send the embedded object directly instead of the whole worksheet?

I was thinking maybe something like:

dim Drawing as object

Sheet1.select
Drawing = Object1

.attachments.add ("Drawing")

 

[CBurgess]

    Sheets("Menu").Visible = True
    Sheets("Menu").Select
    
    ActiveSheet.Shapes.range(Array("Drawing")).Select
    
    Selection.Verb Verb:=xlPrimary
    
    Sheets("EXM").Select
    Sheets("Menu").Visible = False

This code is used to bring up the embedded sheet, as in open it. So how can I not open it, but simply "attatch" it? :/

 

[EPURON]

To add the attachment properly you simply do

.Attachments.Add Drawing.FullName

 

[EPURON]

Ok so i edited the code with your code that you have gave me.

Sub epuron()
    Dim OutApp As Object
    Dim OutMail As Object
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    On Error Resume Next
    Sheets("Menu").Visible = True
    Sheets("Menu").Select
    ActiveSheet.Shapes.Range(Array("Drawing")).Select
    Selection.Verb Verb:=xlPrimary
    Sheets("EXM").Select
    Sheets("Menu").Visible = False
   ' Change the mail address and subject in the code before you run it.
   ' sends message with attachment for outlook
    With OutMail
        .To = " 'the main email that the pdf will send to' "
        .CC = ""
        .BCC = ""
        .Subject = " 'input subject title between quotation marks "
        .Body = " 'input body message between quotation marks "
        .Attachments.Add Drawing.FullName
        .Send
    End With
    On Error GoTo 0
    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

Try this, I'm doing this from the top of my head :D

 

[CBurgess]

Am sorry, I don't get the FullName part?

So you're saying .Attachments.Add Worksheets("Menu").FullName will work?

or

.Attachments.Add Sheet1.FullName

or

.Attachments.Add Sheet1.Drawing

 

[CBurgess]

Here have some more code haha,

Private Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long

Sub Email_Click()

   
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String
    Dim partNO As String
    Dim quantNO As String
    Dim insideName As String
    Dim ProductDes1 As String
    Dim ProductDes2 As String
    Dim customName As String
    Dim AccountNo As String
    Dim DeliveryReq As String
    Dim Competition As String
    Dim Note As String
    Dim Name As String
    Dim Drawing As Object
    
    Dim EXMws As Worksheet
    
    Sheet2.Unprotect
    partNO = Sheet2.range("B9")
    quantNO = Sheet2.range("P34")
    'Dim insideName As String
    ProductDes1 = Sheet2.range("M11")
    ProductDes2 = Sheet2.range("M15")
    customName = Sheet2.range("P28")
    AccountNo = Sheet2.range("P30")
    DeliveryReq = Sheet2.range("P32")
    Note = Sheet2.range("M23")
    'Dim Competition As String
    Name = Sheet12.range("K19")
    Sheet2.Protect
    
    
    Sheets("Menu").Visible = True
    Sheets("Menu").Select
    
    ActiveSheet.Shapes.range(Array("Drawing")).Select
    Selection.Verb Verb:=xlPrimary
    
    Sheets("EXM").Select
    Sheets("Menu").Visible = False
    
              
    If quantNO = ("") Then
   MsgBox "Please make sure you fill in all fields before proceeding." + vbNewLine + "If a field is unknown please enter N/A", vbOKOnly, "aa"
    Else

    If customName = ("") Then
   MsgBox "Please make sure you fill in all fields before proceeding." + vbNewLine + "If a field is unknown please enter N/A", vbOKOnly, "aa"
    Else

    If AccountNo = ("") Then
   MsgBox "Please make sure you fill in all fields before proceeding." + vbNewLine + "If a field is unknown please enter N/A", vbOKOnly, "aa"
    Else

    If DeliveryReq = ("") Then
   MsgBox "Please make sure you fill in all fields before proceeding." + vbNewLine + "If a field is unknown please enter N/A", vbOKOnly, "aa"
    Else
    
    If Note = ("Please use this box for information such as target pricing and potential competition. 
") Then
    MsgBox "Please make sure you fill in the note field if not needed please leave blank.", vbOKOnly, "aa"
    Else
    
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    
    strbody = " <big>Hello " + Name + " 

 </big>"
    strbody = strbody & " <big>Please can you arrange a P&D Request for the following part number " + partNO + " this will consist of " + quantNO + " piece(s). </big>


"
    strbody = strbody & " <big>The project will consist of: </big>

"
    strbody = strbody & " <big>" + ProductDes1 + "

" + ProductDes2 + "</big>


"
    strbody = strbody & " <big>The customer is " + customName + " and their account number is " + AccountNo + "</big>"
    strbody = strbody & " <big>they have a projected delivery requirement of " + DeliveryReq + "</big>


"
    strbody = strbody & " <big>Note:</big> 

"
    strbody = strbody & " <big>" + Note + "</big>



"
    strbody = strbody & " <big>Thank you,</big> 


"

    strbody = strbody & " <small>THIS IS AN AUTOMATED MESSAGE FOR QUERIES REGARDING THE ASSEMBLY PLEASE CONTACT THE SENDER</small>
"
    strbody = strbody & " <small>FOR QUERIES REGARDING THE EMAIL TEMPLATE PLEASE CONTACT aaa</small>"
    On Error Resume Next
    
    With OutMail
    .Display
    End With
    
        Signature = OutMail.htmlbody
    With OutMail
        .To = Sheet12.range("L8")
        .CC = ""
        .BCC = ""
        .Subject = "Arrange P&D Request"
        .htmlbody = strbody & vbNewLine & Signature
        .Attachments.Add Drawing.FullName
        
        .Send
        'or use
        '.Display
      
    End With
    On Error GoTo 0
    
    Set OutMail = Nothing
    Set OutApp = Nothing
    MsgBox "Email has been sent", vbOKOnly, "aa"
    
    End If
    End If
    End If
    End If
    End If
    
End Sub

 

[EPURON]

Well if the Drawing is not a worksheet then you can try Sheet1.Drawing as an attachment. Usually i use Fullname as to bring up a worksheet

 

[CBurgess]

nope, Drawing is the name of the PDF.

 

[EPURON]

Ok so i see your lovely code. Try testing it with "Drawing.Fullname" but if its not working then try "Worksheets("Drawing")"