Help with Code - send email thru Notes with Unique attachments

[wjmoore]

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-comfficeffice" /><o> </o>
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> </o>
MailDoc.SaveMessageOnSend = True
MailDoc.PostedDate = Now
On Error GoTo Audi
Call MailDoc.Send(False)
Audi: On Error GoTo 0
Next
<o> </o>
Set Maildb = Nothing: Set MailDoc = Nothing: Set Session = Nothing
End Sub

 

[John_w]

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]

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]

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]

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]

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

 

[John_w]

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:

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]

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.