Link to home
Start Free TrialLog in
Avatar of stmoritz
stmoritz

asked on

use excel vba to send an excel range + attachment by email through outlook

I have been using the code below to send emails with attachments through outlook out of excel. it works fine if i enter body text and email recipients in the code. However, I would much prefer to use cell values as recipients or body text for the email. Unfortunately, I have not been very successful at it yet.

If I run the code, the error message "There must be at least one name or distribution list in the To, Cc or Bcc box." appears.

Neither .Recipients.Add(Range("MailTo")) nor .Recipients.Add(MailTo) works...

Any help appreciated.

I use Office 2003.
Sub SendPdfInvoice()
   'send pdf invoice

   Sheets("invoice").Select
   Range("MailBody").Select
   
   Dim MailToAdress As String
    MailToAdress = Range("MailTo").Value
   Dim MailBccAdress As String
    MailCcAdress = Range("MailCc").Value
   Dim MailSubject As String
    MailSubject = Range("MailSubject").Value
   


' creates and sends a new e-mail message with Outlook

Dim OLF As Outlook.MAPIFolder, olMailItem As Outlook.MailItem
Dim ToContact As Outlook.Recipient
    Set OLF = GetObject("", _
        "Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
    Set olMailItem = OLF.Items.Add ' creates a new e-mail message
    With olMailItem
        .Subject = Range("MailSubject").Value ' message subject
        'Set ToContact = .Recipients.Add("james@bond.com") ' add a recipient
        Set ToContact = .Recipients.Add(Range("MailTo")) ' add a recipient
        Set ToContact = .Recipients.Add(MailCcAddress) ' add a recipient
        ToContact.Type = olCC ' set latest recipient as CC
        .Body = "Also this text I would like to replace with the range in the excel sheet named MailBody instead of writing it here" & Chr(13)
        ' the message text with a line break
        .Attachments.Add Range("PdfPath").Value, olByValue, , _
            "Attachment" ' insert attachment
        .OriginatorDeliveryReportRequested = False ' delivery confirmation
        .ReadReceiptRequested = False ' read confirmation
        .Send ' sends the e-mail message (puts it in the Outbox)
    End With
    Set ToContact = Nothing
    Set olMailItem = Nothing
    Set OLF = Nothing

End Sub

Open in new window

Avatar of Saurabh Singh Teotia
Saurabh Singh Teotia
Flag of India image

I assume your name ranges are properly declare in your workbook. If not then first please check them.
Also try adding the sheet name on which these name ranges exists what i mean is this...
Saurabh...

MailToAdress = Sheets("Your Sheet Name here where this value exists").Range("MailTo").Value
   Dim MailBccAdress As String
    MailCcAdress = Sheets("Your Sheet Name here where this value exists"). Range("MailCc").Value

Open in new window

Avatar of stmoritz
stmoritz

ASKER

Thanks. Error still remains after changing as you suggested to

Dim MailToAdress As String
    MailToAdress = Sheets("invoice").Range("MailTo").Value
   Dim MailCcAdress As String
    MailCcAdress = Sheets("invoice").Range("MailCc").Value
   Dim MailSubject As String
    MailSubject = Sheets("invoice").Range("MailSubject").Value

And further below to

        Set ToContact = .Recipients.Add(MailToAddress) ' add a recipient



So somehow this way the value does not get from the range "MailTo" to "MailToAddress"

However, if changed to

        Set ToContact = .Recipients.Add(Range("MailToAddress")) ' add a recipient
        Set ToContact = .Recipients.Add(Range("MailCcAddress")) ' add a recipient
        ToContact.Type = olCC ' set latest recipient as CC

i get the error 1004: "Method 'Range' of object '_Global' failed

...?? any help appreciated, thanks a lot.





Dim MailToAdress As String
    MailToAdress = Sheets("invoice").Range("MailTo").Value
   Dim MailCcAdress As String
    MailCcAdress = Sheets("invoice").Range("MailCc").Value
   Dim MailSubject As String
    MailSubject = Sheets("invoice").Range("MailSubject").Value

Open in new window

stmoritz,

In the attached file you will find various different options. The simplest is the CDO email which uses the email addresses listed on Sheet1 - that macro responds to the button on that worksheet.

Hope it helps

Patrick
cdo-email-general-app-03.xls
if I change the To field in the code to

.To = Range("MailToAddress").Value

I have the same error message as in the code originally posted:

Run-time erro '1004'
Method 'Range' of object '_Gobal' failed

seems I'm not moving forward here or doing something wrong...
stmoritz,

I have provided you with a working macro. Is there some reason that you want to modify it?

Patrick
Hi Patrick,

Thanks for your solution. However:

1) your macro does not work on my system. Error "The transport failed to connect to the server."

2) I can't see where it allows to attach an attachment with a path that is stored in a cell of the excel sheet, right?

3) to take To/Bcc/Subject etc. from cell values I need to adjust offset values, right?

Thanks.  
stmoritz,

My apologies for not re-checking the macros - I have messed around with them so they need modification - my fault - I'll be back.

Meantime please confirm that you actually want to:

1. Send different files to different people

2. That all the files are in the same directory

Or is it that you want to:

3. Send the ActiveWorkbook to the recipients (without the VBA)?

I will wait for your answers...

Patrick
thanks Patrick

The code creates a pdf out of a range of the active sheet (this works)
 
The second part of the code than should send this pdf by email to a few recipients with text.

The code posted in the initial post works fine to do this and send it, but I have to enter recipients (To, Cc, Bcc), subject and message body in the code itself and I would like the code to take this information from cell values, so that I can use it more flexible and also for other workbooks/purposes.

So it should take the following values from different cell values:
  • Path for attachment (any type of file not particularly related to active workbook in this case pdf)
  • To
  • Cc
  • Bcc
  • Subject
  • Message body text
stmoritz,

I'm afraid that your VBA code is 'alien' to me at it's Outlook rather than Excel-based. However perhaps you can put this whole section of VBA in a loop that iterates through the cells for the data that you need - perhaps like the first 3 emboldened lines, like this:

For i = 2 to lastrowofdata
    With olMailItem

        .Subject = Sheets("Sheet1").cells(i,"E") ' message subject
        Set ToContact = .Recipients.Add Sheets("Sheet1").cells(i,"E")  ' add a recipient
        Set ToContact = .Recipients.Add Sheets("Sheet1").cells(i,"F") ' add a recipient

'and so on...

        ToContact.Type = olCC ' set latest recipient as CC
        .Body = "Also this text I would like to replace with the range in the excel sheet named MailBody instead of writing it here" & Chr(13)
        ' the message text with a line break
        .Attachments.Add Range("PdfPath").Value, olByValue, , _
            "Attachment" ' insert attachment
        .OriginatorDeliveryReportRequested = False ' delivery confirmation
        .ReadReceiptRequested = False ' read confirmation
        .Send ' sends the e-mail message (puts it in the Outbox)
    End With
Next i

Patrick
Hi
This is working for me (I commented out attachment)
Sub SendPdfInvoice()
   'send pdf invoice

   Sheets("invoices").Select
   Range("MailBody").Select
   
   Dim MailToAdress As String
    MailToAdress = Range("MailTo").Value
   Dim MailccAdress As String
    MailccAdress = Range("MailCc").Value
   Dim MailSubject As String
    MailSubject = Range("MailSubject").Value
   


' creates and sends a new e-mail message with Outlook

Dim OLF As Outlook.MAPIFolder, olMailItem As Outlook.MailItem
Dim ToContact As Outlook.Recipient, ccRec As Outlook.Recipient
    Set OLF = GetObject("", _
        "Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
    Set olMailItem = OLF.Items.Add ' creates a new e-mail message
    With olMailItem
        .Subject = Range("MailSubject").Value ' message subject
         .Recipients.Add (Range("MailTo")) ' add a recipient
' I used another variable to store ccRecipient
        Set ccRec = .Recipients.Add(MailccAdress) ' add a recipient
        ccRec.Type = olCC   ' set latest recipient as CC
        .Body = "Also this text I would like to replace with the range in the excel sheet named MailBody instead of writing it here" & Chr(13)
        ' the message text with a line break
'        .Attachments.Add Range("PdfPath").Value, olByValue, , _
'            "Attachment" ' insert attachment
        .OriginatorDeliveryReportRequested = False ' delivery confirmation
        .ReadReceiptRequested = False ' read confirmation
        .Send ' sends the e-mail message (puts it in the Outbox)
    End With
    Set ccRec= Nothing
    Set olMailItem = Nothing
    Set OLF = Nothing

End Sub


hope this helps
stefri
thanks stefri. we sem to getting closer.

I get the error now  

Run-time error '-1456455675 (a9304005)':
Outlook does not recognize one or more names

after clicking on debug I end up at yellow selected
    .Send ' sends the e-mail message (puts it in the Outbox)
are email addresses proprely formed?
I tried with a misformed email address (no @sign) and .Send crashes
Are you using email addresses or names that should be resolved prior sending
Stefri
Hi Stefri. this starts looking very, very good indeed!

If there is only one email address in the field MailCc or MailTo it works.

- How can I add another second cc address? other cell with new name and copy same code?
- Is there a way to replace the body text       .Body = "Also this text I would like to replace with the range in the excel sheet named MailBody instead of writing it here" & Chr(13) in the code also somehow to get it from a named range in the sheet?

Thanks for your appreciated help and time.
>- How can I add another second cc address? other cell with new name and copy same code?
- Is there a way to replace the body text       .Body = "Also this text I would like to replace with the range in the excel sheet named MailBody instead of writing it here" & Chr(13) in the code also somehow to get it from a named range in the sheet?

Please see my earlier comments as I believe I have already answered that in my Comment ID:34119765

Patrick
Usually, outlook accepts addresses separated by semi-colons or
define a range MailTos (more than one cell) and loop through the number cells belongingto that range

About body, declare a named range bodyTosend and get though range("bodyToSend").value as you do for recipeint, ccrec, etc

look at the code below

Sub SendPdfInvoice()
   'send pdf invoice
Dim aCell As Object

   'Sheets("invoices").Select
   Range("MailBody").Select
   
   Dim MailToAdress As String
    MailToAdress = Range("MailTo").Value
   Dim MailccAdress As String
    MailccAdress = Range("MailCc").Value
   Dim MailSubject As String
    MailSubject = Range("MailSubject").Value
   Dim mailBody As String
   mailBody = Range("MailBody").Value


' creates and sends a new e-mail message with Outlook

Dim OLF As Outlook.MAPIFolder, olMailItem As Outlook.MailItem
Dim ToContact As Outlook.Recipient, ccRec As Outlook.Recipient
    Set OLF = GetObject("", _
        "Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
    Set olMailItem = OLF.Items.Add ' creates a new e-mail message
    With olMailItem
        .Subject = Range("MailSubject").Value ' message subject
        For Each aCell In Range("mailtos").Cells
            If Not (IsEmpty(aCell)) Then
               .Recipients.Add aCell.Value ' add a recipient
            End If
         Next
' I used another variable to store ccRecipient
        Set ccRec = .Recipients.Add(MailccAdress) ' add a recipient
        ccRec.Type = olCC   ' set latest recipient as CC
        .Body = VBA.Replace(mailBody, Chr(10), Chr(13), 1, -1, vbTextCompare)
'        .Attachments.Add Range("PdfPath").Value, olByValue, , _
'            "Attachment" ' insert attachment
        .OriginatorDeliveryReportRequested = False ' delivery confirmation
        .ReadReceiptRequested = False ' read confirmation
        .Display ' sends the e-mail message (puts it in the Outbox)
    End With
    Set ccRec = Nothing
    Set olMailItem = Nothing
    Set OLF = Nothing

End Sub
Pretty weird. It works as long as I have only one email address in the MailTo or MailCc field, whether with comma or semicolon, it doesn't work...

Also the way to take the body text out of the sheet instead of the code does not work here with me. no text is in the email message and the email is being sent but not delivered, as the error message (in outlook inbox) undeliverable:

This message could not be sent. Try sending the message again later, or contact your network administrator.  Error is [0x80070057-00000000-00000000].

appears.

question to Stefri: does it work in your sheet and if yes, could you maybe post that sheet with the code?

question to Patrickab: sorry somehow I overlooked your solution ID: 34119765 - does it work for you and might it solve the problem to get the content of an excel range into the message body? sorry, I know you are more excel than outlook ;-)
>...I overlooked your solution ID: 34119765 - does it work for you and might it solve the problem to get the content of an excel range into the message body? sorry, I know you are more excel than outlook ;-)

In Excel I cycle through cells containing the email addresses and for the body text and anything else that changes from one email to the next and it works well.

Patrick
Maybe posting the file with the current code might help as I dont' move forward.

Current code on my machine does not add cc and does not add mailbody. Furthermore, the sender name/email remains empty, so outlook does not send it out (see error in ID: 34137645).

any further help appreciated.
EE-invoice.xls
okay, nothing seems to move... now I try it the other way with another code

This code works and does exactly what it should, however, somehow I should add an attachment to this mail, that's the only thing missing...

Attachment path and file name is stored in the excel sheet range "PdfPath"

'        .Attachments.Add Range("PdfPath").Value, olByValue, , _
'            "Attachment" ' insert attachment


Sub SendPdfInvoice2()
   'send pdf invoice

   ' Select the range of cells on the active worksheet.
   Sheets("invoice").Select
   
   Range("MailBody").Select
   
   Dim MailToAddress As String
    MailToAddress = Range("MailTo").Value
   Dim MailCcAddress As String
    MailCcAddress = Range("MailCc").Value
   Dim MailSubject As String
    MailSubject = Range("MailSubject").Value

   
   ' Show the envelope on the ActiveWorkbook.
   ActiveWorkbook.EnvelopeVisible = True
   
   ' Set the optional introduction field thats adds
   ' some header text to the email body. It also sets
   ' the To and Subject lines. Finally the message
   ' is sent.
   With ActiveSheet.MailEnvelope
      .Item.To = MailToAddress
      .Item.CC = MailCcAddress
      .Item.Subject = MailSubject
      .Item.Send
   End With
   
   
End Sub

Open in new window

ASKER CERTIFIED SOLUTION
Avatar of stmoritz
stmoritz

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
stmoritz
I am disapointed you are closing the question as my post was doing what you wanted
Nevertheless, as a gift, I offer you spreadsheet with lot of corrections on Mailsubject and othernamed ranges not properly defined or missing
stefri stefri-EE-invoice.xlsm
Hi stefri. Thanks a lot, however, your solution did not do all that I was looking for and did not work correctly, as you can see also from post 34137645. The code I arrived at the end does everything I have been looking for perfectly and the way I want it and does it without any error or problem. But many thanks for the file, I will have a look at it and check it. Thanks a lot for your understanding.
works perfect! exactly what i needed!