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
 

Excel Facts

Difference between two dates
Secret function! Use =DATEDIF(A2,B2,"Y")&" years"&=DATEDIF(A2,B2,"YM")&" months"&=DATEDIF(A2,B2,"MD")&" days"

John_w

MrExcel MVP
Joined
Oct 15, 2007
Messages
7,003
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
7,003

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

Forum statistics

Threads
1,141,740
Messages
5,708,235
Members
421,553
Latest member
Geeyj

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
Top