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.
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