Thread: PDF as attachment

Dear All,
I am trying to send a common e mail to many clients to creat awareness for the enviornment.I am getting as far as creating E mails but I am not able to attach the PDF file to the E mail which is placed on my desktop ..
here is the code and the Excel work Book (Dummy ) an an example.

Sub TestFile()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim Rng As Range
    Dim i As Integer
    Dim strbody As String

    
    Dim LR As Long
    Dim eRng As Range
    Dim eCell As Range
    
    'Find last row with data in Column L (Email Addresses)
    LR = Range("L" & Rows.Count).End(xlUp).Row

    Application.ScreenUpdating = False
    Set OutApp = CreateObject("Outlook.Application")

    On Error GoTo cleanup
    
    'Set the range of Email Addresses
    Set eRng = Range("L2:L" & LR)
    
    'Cycle through each cell in Column L (each Email Address)
    For Each eCell In eRng

        If eCell.Value <> "" And _
                eCell.Offset(0, 19).Value = "Active" _
                Or eCell.Offset(0, 19).Value = "Active " Then

           
            Set OutMail = OutApp.CreateItem(0)
            On Error Resume Next
            With OutMail
                .To = eCell.Value
                .CC = "Go Green"
                '.BCC = eCell.Offset(0, 2)
                .Subject = eCell.Offset(0, -5)
                
    strbody = "Dear Partner" & vbNewLine & vbNewLine & _
              "In an effort to promote environmental and economic health for all" & vbNewLine & _
                           "TLLP INC."
            .Attachments.Add ("C:\Documents and Settings\m\Desktop")
             
                '.Send  'Or use
                .Display
            End With
            On Error GoTo 0
            Set OutMail = Nothing
        End If
    Next eCell

cleanup:
    Set OutApp = Nothing
    Application.ScreenUpdating = True
End Sub

Hi N

Here's a link to code I use when I wish to send a PDF from Excel with Outlook. What the code does essentially is, it creates a PDF file from what the code tells it to and then does the Email thing. I suspect this is NOT what your trying to do...however, the code CAN be modified to do WHAT I suspect you're trying to do.

What I suspect is that you have a currently existing PDF file you wish to Email to certain people that are listed in your attached file. If my suspicions are correct, try to modify the code to do as you require...if you're stuck, attach a generic copy of your PDF and I'll show you how. I actively use code that does exactly this.

Originally Posted by jaslake

What I suspect is that you have a currently existing PDF file you wish to Email to certain people that are listed in your attached file. If my suspicions are correct, try to modify the code to do as you require...if you're stuck, attach a generic copy of your PDF and I'll show you how. I actively use code that does exactly this.

you are correct J but the link is missing here in your reply can you resend it for me to work on ..
rgds
N

Hi N

Sorry 'bout that...thought I'd copied the link...here it is http://msdn.microsoft.com/en-us/libr...ffice.11).aspx

Dear J,
Thanks for the effort .I have managed to get as far as generating e mail ,but without attachment ,all the codes I ref. to talk about creating workbooks,worksheets,csv,text files and then sending .pdf as an attachment ,I dont want to creat pdf ,just want to attachthe one that's there on the desktop to all the e mails i am sending.Here is the code for you ,the only problem is I am not able to get the pdf file as an attachement to these e mails .

Option Explicit
Sub Testn()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim Rng As Range
    Dim LR As Long
    Dim eRng As Range
    Dim eCell As Range
    LR = Range("L" & Rows.Count).End(xlUp).Row
    Application.ScreenUpdating = False
    Set OutApp = CreateObject("Outlook.Application")
    On Error GoTo cleanup
    Set eRng = Range("L2:L" & LR)
    For Each eCell In eRng
    If eCell.Value <> "" And _
    eCell.Offset(0, 19).Value = "Active" _
    Or eCell.Offset(0, 19).Value = "Active " Then
    Set OutMail = OutApp.CreateItem(0)
    On Error Resume Next
    With OutMail
    .To = eCell.Value
    .CC = "G"
    .Subject = eCell.Offset(0, -5)
    .HTMLBody = "Dear,<br></br>" & _
                "<br>text 1,<b>text2.</b> text3 <b><font color =green>Campaign.</b></font></h4>text4.<br>" & _
                "<br>text6." & _
                "text7.<br><br>" & _
                "text8:" & "<br><br><u><font color =blue> text9</u> <br><BR></font>" & _
                "text10</BR>" & _
                "<br><br>Thank you<br>" & _
                "<H4>text11 </H4></BR>"
                '.Send
                .Display
            End With
            On Error GoTo 0
            Set OutMail = Nothing
        End If
    Next eCell
cleanup:
    Set OutApp = Nothing
    Application.ScreenUpdating = True
End Sub
Function RangetoHTML(Rng As Range)
    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook
    TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
    Rng.Copy
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
        .Cells(1).Select
        Application.CutCopyMode = False
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
    End With
    With TempWB.PublishObjects.Add( _
            SourceType:=xlSourceRange, _
            Filename:=TempFile, _
            Sheet:=TempWB.Sheets(1).Name, _
            Source:=TempWB.Sheets(1).UsedRange.Address, _
            HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    RangetoHTML = ts.ReadAll
    ts.Close
    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
            "align=left x:publishsource=")
    TempWB.Close savechanges:=False
    Kill TempFile
    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function

Hi N

The attached is a modification of the procedure I personally use to email PDF's for an organization I'm involved with. Try it and see what works and/or doesn't work for you.

You'll need to change two lines of code in Module1
This line of code needs to be set to the path where your PDF file lives

ChDir "C:\Documents and Settings\Administrator\Desktop\"  'You'll need to change this

This line of code needs to be set to the path where your signature lives

SigString = "C:\Documents and Settings\" & Environ("username") & _
            "\Application Data\Microsoft\Signatures\JAS.htm"            'You'll need to change this

let me know of issues.

Dear J
Bulls Eye ..
Regards

Dear J,
I somehow managed to tweak your code to match my requirement but now I am stuck bigtime and need your help, problem is, I am not able to modify the Subject of the Email in a specific format.I am attaching the working for your valuable feedback.
Regards

Hi N
Is this the same project as the subject of my Post #6? If it is, what happened to the procedure to update location? The code in the workbook attached to my Post #6 will require another approach to accommodate your most recent requirements.

Dear J,
This is not much related to post# 6.I am tweaking your post # 6 reply for a new assignment which does not involve location, it has more to do with the reminders to external associates.Regards

Hi N

You can't introduce a new project into this Thread...Forum Rules and etiquette don't allow it. If this Tread is solved, please mark it as such.

Then please start a new thread for your new issue.

oooppppsss!!!! Thnks J for reminding me I have posted the new thread ..Regards

Hi N
I see you've marked your Thread as solved. Now, start a NEW Thread detailing your NEW requirements. Attach your file to the NEW Thread. PM me with the NEW Thread reference an I'll look at it.