Help with Code - send email thru Notes with Unique attachments

wjmoore

New Member
Joined
Mar 15, 2011
Messages
5
Newbie alert!

I have read the forum, found and modified code to use Excel to send an email via Lotus Notes. I have the email working and really enjoy the power of VB. I see a class in the near future.

I have a spreadsheet with Comany Name in column A and email address in column B. How do I get it to auto populate the Company name into the subject line and attach a unique attachment(with same company name) to each email? I also found the spoofing code for reply to address but need to know where to insert it.

Any help is appreciated.

The code I have thus far is:

Sub email()
<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:eek:ffice:eek:ffice" /><o:p> </o:p>
Dim Maildb As Object, UserName As String, MailDbName As String
Dim MailDoc As Object, Session As Object
Dim cl As Range
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 Not Maildb.IsOpen Then Maildb.OpenMail
For Each cl In Range([b2], [b65536].End(3))
Set MailDoc = Maildb.CreateDocument
MailDoc.Form = "Memo"
MailDoc.SendTo = Right$(cl, Len(cl) - 1) 'Nickname or full address
'MailDoc.CopyTo = Whomever
MailDoc.BlindCopyTo = "blind@mydomain.com"
MailDoc.Subject = "COMPANY NAME &SUBJECT TEXT"
MailDoc.Body = _
Replace("Hello, @@" & _
"BODY TEXT " & _
cl(, 2) & _ 'what does this designate?
" BODY TEXT " & _
"@@Your response to this request in the next 5 business days is highly appreciated." & _
"@@Regards," & _
"@@William Moore" & _ , "@", vbCrLf)
<o:p> </o:p>
MailDoc.SaveMessageOnSend = True
MailDoc.PostedDate = Now
On Error GoTo Audi
Call MailDoc.Send(False)
Audi: On Error GoTo 0
Next
<o:p> </o:p>
Set Maildb = Nothing: Set MailDoc = Nothing: Set Session = Nothing
End Sub
 

Some videos you may like

Excel Facts

Get help while writing formula
Click the italics "fx" icon to the left of the formula bar to open the Functions Arguments dialog. Help is displayed for each argument.

John_w

MrExcel MVP
Joined
Oct 15, 2007
Messages
6,432
Your For Each cl loop is looping through column B, so to get the company name in column A (1 column to the left) in the Subject text, try

MailDoc.Subject = cl.Offset(, -1).Value & " SUBJECT TEXT"

For the reply-to email address, try:

MailDoc.ReplyTo = "name@email.com"

after the CopyTo line.

For the attachment, use MailDoc.CreateRichTextItem to create a rich text item object, then EMBEDOBJECT on the RTI object to embed the attachment file. My code here shows how - http://www.mrexcel.com/forum/showthread.php?t=531626
 

wjmoore

New Member
Joined
Mar 15, 2011
Messages
5
Thank you for the reply.

The attachment code you refference would send a single attachment to all recipients. I have a unique attachment for each recipient. Is there a way to list the attachments in column C or list the path and use the company name for the look up?

I will try the other code you and advise.

Thanks again.
 

wjmoore

New Member
Joined
Mar 15, 2011
Messages
5
The range identification for the Name in the subject line worked perfectly.

The reply to address worked as well. Only it still looks as if it came from the original address and asks for reply's to be sent to the 2nd address. Do you know to make it look as if it was sent from the 2nd address?

I could list the attachment paths in column C, is there a way to set range and have it attach the designated files?

Thanks again for your time and assistance.
 

John_w

MrExcel MVP
Joined
Oct 15, 2007
Messages
6,432

ADVERTISEMENT

The reply to address worked as well. Only it still looks as if it came from the original address and asks for reply's to be sent to the 2nd address. Do you know to make it look as if it was sent from the 2nd address?
Set the MailDoc.Principal field to the required email address.
I could list the attachment paths in column C, is there a way to set range and have it attach the designated files?
Use cl.Offset(0,1).Value to get the file name in the column C cell, then attach it using the technique I've already described and shown in the thread I linked to.
 

wjmoore

New Member
Joined
Mar 15, 2011
Messages
5
Thanks for the help, Please review below and assist.

Goals accomplished:

1 Create Email Session
2 Set Reply to address to secondary address
2 Set company name in Subject
3 Set Array for Recipient Addresses
4 Create Body
5 Send and Close

The last piece I am having trouble with is creating the Attachments Array.

My Spreadsheet has 3 columns
A= Company Name
B= Email Address
C= Attachment ( C:\Attachments\attachment.xls)

I have added your 'Attachments as Variant code and I get:

Compile error:
Invalid or unqualified reference

On the line:
Set NRichTextItem = .CREATERICHTEXTITEM("Attachment_" & i)

Here is my current compilation of code, the blue text should be the attachment functionality.

Thanks again.

Sub email()<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:eek:ffice:eek:ffice" /><o:p></o:p>
<o:p></o:p>
'Create Session<o:p></o:p>
Dim Maildb As Object, UserName As String, MailDbName As String<o:p></o:p>
Dim MailDoc As Object, Session As Object<o:p></o:p>
Dim cl As Range<o:p></o:p>
Dim NRichTextItem As Object 'The attachment rich text file object<o:p></o:p>
Dim NEmbeddedObj As Object 'The embedded object (Attachment)<o:p></o:p>
Dim AttachmentsArray As Variant<o:p></o:p>
Dim i As Integer<o:p></o:p>
Set Session = CreateObject("Notes.NotesSession")<o:p></o:p>
UserName = Session.UserName<o:p></o:p>
MailDbName = Left$(UserName, 1) & Right$(UserName, _<o:p></o:p>
(Len(UserName) - InStr(1, UserName, " "))) & ".nsf"<o:p></o:p>
Set Maildb = Session.GetDatabase("", MailDbName)<o:p></o:p>
If Not Maildb.IsOpen Then Maildb.OpenMail<o:p></o:p>
<o:p></o:p>
'Get Recipient List<o:p></o:p>
For Each cl In Range([b2], [b65536].End(3))<o:p></o:p>
Set MailDoc = Maildb.CreateDocument<o:p></o:p>
MailDoc.Form = "Memo"<o:p></o:p>
MailDoc.SendTo = Right$(cl, Len(cl) - 1) 'Nickname or full address<o:p></o:p>
<o:p></o:p>
'SPOOF Email Address<o:p></o:p>
MailDoc.From = "Sender@younameit.com"<o:p></o:p>
MailDoc.BlindCopyTo = "Blind@Copy.com"<o:p></o:p>
MailDoc.ReplyTo = " Sender@younameit.com "<o:p></o:p>
Set objNotesField = MailDoc.AppendItemValue("From", EMailFrom)<o:p></o:p>
EMailFrom = " Sender@younameit.com "<o:p></o:p>
<o:p></o:p>
'Set Email Subject<o:p></o:p>
MailDoc.Subject = cl.Offset(, -1).Value & " Subject Text"<o:p></o:p>
<o:p></o:p>
'Create Attachement from Array<o:p></o:p>
If TypeName(Attachments) = "Variant(cl.Offset(0, 1).Value)" Then<o:p></o:p>
AttachmentsArray = Attachments<o:p></o:p>
End If<o:p></o:p>
For i = LBound(AttachmentsArray) To UBound(AttachmentsArray)<o:p></o:p>
Set NRichTextItem = .CREATERICHTEXTITEM("Attachment_" & i)<o:p></o:p>
If Dir(AttachmentsArray(i)) <> "" Then<o:p></o:p>
'Function EMBEDOBJECT(TYPE As Integer, CLASS As String, SOURCE As String, [OBJECTNAME])<o:p></o:p>
Set NEmbeddedObj = NRichTextItem.EMBEDOBJECT(EMBED_ATTACHMENT, "", AttachmentsArray(i))<o:p></o:p>
Else<o:p></o:p>
MsgBox "Attachment file not found: " & AttachmentsArray(i)<o:p></o:p>
End If<o:p></o:p>
<o:p></o:p>
'EMAIL BODY<o:p></o:p>
MailDoc.Body = _<o:p></o:p>
Replace("Hello, @@" & _
"BODY TEXT " & _
" BODY TEXT " & _
" @@ BODY TEXT " & _
"@@Regards," & _, "@", vbCrLf)<o:p></o:p>
<o:p></o:p>
'On Error<o:p></o:p>
MailDoc.SaveMessageOnSend = True<o:p></o:p>
MailDoc.PostedDate = Now()<o:p></o:p>
On Error GoTo Audi<o:p></o:p>
Call MailDoc.Send(False)<o:p></o:p>
Audi: On Error GoTo 0<o:p></o:p>
Next<o:p></o:p>
<o:p></o:p>
'Close<o:p></o:p>
Set Maildb = Nothing: Set MailDoc = Nothing: Set Session = Nothing<o:p></o:p>
End Sub<o:p></o:p>
 

John_w

MrExcel MVP
Joined
Oct 15, 2007
Messages
6,432
The last piece I am having trouble with is creating the Attachments Array.

My Spreadsheet has 3 columns
A= Company Name
B= Email Address
C= Attachment ( C:\Attachments\attachment.xls)
You don't need the Attachments array for your particular situation. The array is just a way of having multiple attachments per email, for the particular code I linked to. You have 1 attachment per email, so no need for an array.

As I mentioned, all you need to add an attachment to an email is a rich text item (created with Maildoc object's CreateRichTextItem method) and the RTI's EmbedObject method. These can be combined into a single statement. Try this:
Code:
Option Explicit

Const EMBED_ATTACHMENT As Long = 1454

Sub Send_Lotus_Notes_Emails()

    Dim Maildb As Object, UserName As String, MailDbName As String
    Dim MailDoc As Object, Session As Object
    Dim cl As Range
    Dim file As String
    
    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 Not Maildb.IsOpen Then Maildb.OpenMail
    
    For Each cl In Range([b2], [b65536].End(xlUp))
        Set MailDoc = Maildb.CreateDocument
        
        With MailDoc
            .Form = "Memo"
            
            'Spoof the 'From' email address.  Note that the @MyNotesDomain part (which must be set to YOUR actual
            'Lotus Notes domain) must be present in the Principal field

            .Principal = "Joe Bloggs< joe.bloggs@domain.com@MyNotesDomain >"
            
            .SendTo = cl.Value
            .ReplyTo = "Reply.To@domain.com"
            '.CopyTo = "Copy.To@domain.com"
            '.BlindCopyTo = "BCC@domain.com"
            
            .Subject = cl.Offset(, -1).Value & " SUBJECT TEXT"
            .Body = "This is the email body text." & vbNewLine & "Second paragraph."
            
            .SaveMessageOnSend = True
            .PostedDate = Now
                    
            file = cl.Offset(, 1).Value            'File from column C cell
            If Dir(file) <> "" Then
                .CreateRichTextItem("Attachment").EmbedObject EMBED_ATTACHMENT, "", file
            Else
                MsgBox "File " & file & " not found, so not attached to email"
            End If
            
            .Send False
        End With
        
    Next
Note - in the Principal line I've had to add a space after the '<' and before the '>' to prevent the forum software interpreting the line as HTML. You should remove these spaces in your code.
 

wjmoore

New Member
Joined
Mar 15, 2011
Messages
5
Worked like a dream. Thank you so much for your time and help. VB is powerful, I just picked up a book and see a class in the near future.
 

Watch MrExcel Video

Forum statistics

Threads
1,109,549
Messages
5,529,471
Members
409,884
Latest member
Msinmath
Top