VBA to email cc using addresses in cells

Samlise

New Member
Joined
Nov 8, 2013
Messages
27
Hi

I am trying to sort a VBA that will send out some emails with a PDF attachment

I have got the main part of the macro sorted so that it sends the email with the attachment but I just need a few tweaks ....


I need to add three cc recipients to email addresses found in cells AC20, AC21 & AC22 on the current sheet
I also need to bulk up the main body of the email to be on multiple lines

Below is as far as I have got (Thank you google), if anyone can alter it to fit the requirements that would be fantastic.

VBA Code:
Sub Email()
'

Dim UserName As String
Dim MailDbName As String
Dim Recipient As Variant
Dim ccRecipient As String
Dim Attachment1 As String

Dim Maildb As Object
Dim MailDoc As Object
Dim AttachME As Object

Dim Session As Object
Dim EmbedObj1 As Object

Dim stSignature As String

With Application
.ScreenUpdating = False
.DisplayAlerts = False

' Open and locate current LOTUS NOTES User

Set Session = CreateObject("Notes.NotesSession")
UserName = Session.UserName
MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
Set Maildb = Session.GetDatabase("", MailDbName)
If Maildb.IsOpen = True Then
Else
Maildb.OPENMAIL
End If

' Create New Mail and Address Title Handlers

Set MailDoc = Maildb.CREATEDOCUMENT

MailDoc.Form = "Memo"

stSignature = Maildb.GetProfileDocument("CalendarProfile").GetItemValue("Signature")(0)
' Select range of e-mail addresses
Recipient = Range("AC19").Value
MailDoc.SendTo = Recipient
MailDoc.subject = "XYZ"
MailDoc.Body = _
"This document has been raised and you are the lucky person who is responsible, you're welcome!"

' Select Workbook to Attach to E-Mail

MailDoc.SaveMessageOnSend = True
Attachment1 = "C:\Desktop" '"C:\YourFile.xls" ' Required File Name

If Attachment1 <> "" Then
On Error Resume Next
Set AttachME = MailDoc.CREATERICHTEXTITEM("XYZ")
Set EmbedObj1 = AttachME.embedobject(1454, "XYZ", "C:\Desktop", "") 'Required File Name
On Error Resume Next
End If


MailDoc.PostedDate = Now()
On Error GoTo errorhandler1
MailDoc.Send 0, Recipient

Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing

Set Session = Nothing
Set EmbedObj1 = Nothing

.ScreenUpdating = True
.DisplayAlerts = True
End With

errorhandler1:

Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing

Set Session = Nothing
Set EmbedObj1 = Nothing

End Sub
 

Excel Facts

Remove leading & trailing spaces
Save as CSV to remove all leading and trailing spaces. It is faster than using TRIM().
I am not a lotus notes user but can suggest the following:

You have declared this line in the top of your code

VBA Code:
Dim ccRecipient As String

In the code area below where you are using this

VBA Code:
Recipient = Range("AC19").Value


Then add this in below

VBA Code:
Recipient = Range("AC19").Value
ccRecipient= Range(“AC20”)&”;”&Range(“AC21”)&”;”&Range(“AC22”)

When you want to use multiple lines in your main body of the email you can use vbCr or Chr(13) as carriage return
 
Upvote 0
Thanks Trevor but it didn't like that, just highlights the ccRecipient line in red and says Syntax error
 
Upvote 0
Try adjusting the top dim line to from String to Variant.

VBA Code:
Dim ccRecipient As Variant

Next try just adding the first range to the ccRecipent with a value then you can work on the concatenation part.

VBA Code:
ccRecipient= Range(“AC20”).Value
 
Upvote 0
Adjust the dim back to String

VBA Code:
Dim ccRecipient As String

Where you have

VBA Code:
Recipient = Range("AC19").Value
MailDoc.SendTo = Recipient

Add this just below

VBA Code:
ccRecipient = Range("AC20").Value
MailDoc.CopyTo = ccRecipient
 
Upvote 0
Happy to help. Pleased to read you have a working solution. Thank you for letting me know
 
Upvote 0

Forum statistics

Threads
1,223,956
Messages
6,175,616
Members
452,661
Latest member
Nonhle

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top