Problem with sending multiple attachmenst thru Lotus Notes

[MrTinkertrain]

Hello Excelexperts,

I've found some code online (could be from this site, but I don't know for sure) which allows me to send multiple attachments thru Lotus Notes.

Sub Lotus()
Dim oSess As Object
Dim oDB As Object
Dim oDoc As Object
Dim oItem As Object
Dim direct As Object
Dim Var As Variant
Dim flag As Boolean
Dim MyRange As String
Dim MyRange2 As String
Dim MyRange3 As String
Dim MyRange4 As String
Dim MyRange5 As String
Dim MyRange6 As String
Dim MyMail As String
Dim MyMail1 As String
Dim MyMail2 As String
Dim MyMail3 As String
Dim MyMail4 As String
Dim recip(5) As Variant


MyMail = Range("AG2").Value
MyMail1 = Range("AG3").Value
MyMail2 = Range("AG4").Value
MyMail3 = Range("AG5").Value
MyMail4 = Range("AG6").Value

recip(0) = "someone@someone.com"
recip(1) = "john.doe@someone.com"
recip(2) = MyMail1
recip(3) = MyMail2
recip(4) = MyMail3
recip(5) = MyMail4

Set oSess = CreateObject("Notes.NotesSession")
Set oDB = oSess.GETDATABASE("", "")
Call oDB.OPENMAIL
flag = True
If Not (oDB.IsOpen) Then flag = oDB.Open("", "")

If Not flag Then
MsgBox "Can't open mail file: " & oDB.SERVER & " " & oDB.FILEPATH
GoTo exit_SendAttachment
End If
On Error GoTo err_handler

'Building Message
Set oDoc = oDB.CREATEDOCUMENT
Set oItem = oDoc.CREATERICHTEXTITEM("BODY")
oDoc.Form = "Memo"
oDoc.Subject = "NADRUKORDER"
oDoc.Sendto = recip
oDoc.Body = ""
oDoc.postdate = Date
oDoc.SaveMessageOnSend = True

MyRange = Range("S14").Value
MyRange2 = Range("S32").Value
MyRange3 = Range("S33").Value
MyRange4 = Range("S34").Value
MyRange5 = Range("S35").Value
MyRange6 = Range("S36").Value

'Attaching DATABASE
Call oItem.EmbedObject(1454, "", MyRange)
Call oItem.EmbedObject(1454, "", MyRange2)
Call oItem.EmbedObject(1454, "", MyRange3)
Call oItem.EmbedObject(1454, "", MyRange4)
Call oItem.EmbedObject(1454, "", MyRange5)
Call oItem.EmbedObject(1454, "", MyRange6)


oDoc.visable = True
'Sending Message
oDoc.Send False
exit_SendAttachment:
On Error Resume Next
Set oSess = Nothing
Set oDB = Nothing
Set oDoc = Nothing
Set oItem = Nothing
'Done
Exit Sub
err_handler:
If Err.Number = 7225 Then
MsgBox "Bestand bestaat niet"
Else
MsgBox Err.Number & " " & Err.Description
End If
On Error GoTo exit_SendAttachment


End Sub

This code works like a jiffy, however I encounter a (little) problem.
I'll try to explain what the problem is :

In S14 i've given the location on my C-drive of a default attachment, which always need to be sent.
In cells S32-S36 i've given the location of up to 5 optional extra attachments, which can be sent additionally in the same email.
The code works perfectly if the maximum amount of 5 optional attachments are chosen.
If less than 5 optional attachments are chosen, an error is produced.
It says that a location of the attachment needs to be specified..

I would like to change this code, so that it also works with 1,2,3 or 4 extra attachments are chosen.
Is there someone who can help me out with that ??

Thanks in advance for your advice

Best regards,

Mike

 

[Norie]

Mike

Try this.

Dim rng As Range
'.... other declarations
 
'.... code 
 
' ATTACH DATABASE
 
       Set rng = Range("S14")
 
       Call oItem.EmbedObject(1454, "", rng.Value)
   
       Set rng = Range("S32")
 
       While rng.Value <>""
               
            Call oItem.EmbedObject(1454, "", rng.Value)
       
             Set rng = rng.Offset(1)
 
      Wend

 

[MrTinkertrain]

Works flawlessly, Norie

Many, many thanks

Best regards,

Mike

 

[Norie]

Mike

No problem.

 

[sjmaverick]

Hi Excelexperts


I am relatively new user of doing work in seconds through Macros, I have now in my hand a new task to send various mails with multiple attachments through lotus notes version 8.5.1. I was previously using the enclosed code (Code A)for sending the mails but with single attachment, on googling a little i find the latter and tries to customise the same but it gives error 7224 despite of the fact that file path is specified in the excel sheet. Can anybody help me with either of my earlier code or the latter one which i found on this site

Code A

Sub button1_click()
Dim x As Integer
x = MsgBox("Do You Want to Run the Macro", vbOKCancel + vbQuestion, "Please Enter Your Choice")
If x = vbOK Then
Call Email
Else
Exit Sub
End If
End Sub

Sub Email()
Dim OutlookApp As Object
Dim MItem As Object
Dim cell As Range
Dim email_(5) As Variant
Dim cc_(5) As Variant
Dim subject_ As String
Dim body_ As Variant
Dim attach_ As Variant
Dim Maildb As Object 'The mail database
Dim UserName As String 'The current users notes name
Dim MailDbName As String 'The current users notes mail database name
Dim MailDoc As Object 'The mail document itself
Dim AttachME As Object 'The attachment richtextfile object
Dim Session As Object 'The notes session
Dim EmbedObj As Object 'The embedded object (Attachment)
Dim Subject As String 'The subject string
Dim Attachment As String 'The path to the attachemnt string
Dim Attachment1 As String 'Trying to attach multi files
Dim Recipient As String 'The Recipient string (or you could use the list)
Dim Recip(25) As Variant 'The Recipient list
Dim BodyText As String 'The body text
Dim SaveIt As Boolean 'Save to sent mail
Dim WasOpen As Integer 'Checking to see if the Mail DB was already
Const EMBED_ATTACHMENT As Long = 1454
Sheets("Sheet1").Select
'Loop through the rows
For Each cell In Columns("a").Cells.SpecialCells(xlCellTypeConstants)
email_(0) = cell.Offset(0, 0).Value
email_(1) = cell.Offset(0, 1).Value
email_(2) = cell.Offset(0, 2).Value
email_(3) = cell.Offset(0, 3).Value
email_(4) = cell.Offset(0, 4).Value
subject_ = cell.Offset(0, 5).Value
body_ = cell.Offset(0, 6).Value
'cc_ = cell.Offset(0, 3).Value
cc_(0) = "maverick@helprequired.com"
cc_(1) = "maverick@helprequired.com"
cc_(2) = "maverick@helprequired.com"
cc_(3) = "maverick@helprequired.com"
cc_(4) = "maverick@helprequired.com"
cc_(5) = "maverick@helprequired.com"
'Attachment = cell.Offset(0, 7).Value
'Trying to attach multi files
For i = 1 To 3
'attachment = Attachment1(i)
If i = 1 Then Attachment = Attachment11
ElseIf i = 2 Then Attachment = Attachmnet12
ElseIf i = 3 Then attachmnet = Attachmnet13
End If
Attachment = cell.Offset(0, 7).Value
SaveIt = True
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
WasOpen = 1 'Already open for mail
Else
WasOpen = 0
Maildb.OpenMail 'This will prompt you for password
End If
Set MailDoc = Maildb.CreateDocument
MailDoc.Form = "Memo"

With MailDoc
.sendto = email_
.copyto = cc_
.Subject = subject_
.Body = body_
Set AttachME = MailDoc.CreateRichTextItem("Attachment")
Set EmbedObject = AttachME.EmbedObject(EMBED_ATTACHMENT, "", Attachment)
End With

MailDoc.SaveMessageOnSend = True
MailDoc.PostedDate = Now()
MailDoc.send 0, email_
Next
End Sub



Code B ( Taken from This site)

Sub Lotus()
Dim oSess As Object
Dim oDB As Object
Dim oDoc As Object
Dim oItem As Object
Dim direct As Object
Dim Var As Variant
Dim flag As Boolean
Dim rng As Range
Dim MyRange As String
Dim MyRange2 As String
Dim MyRange3 As String
Dim MyRange4 As String
Dim MyRange5 As String
Dim MyRange6 As String
Dim MyMail As String
Dim MyMail1 As String
Dim MyMail2 As String
Dim MyMail3 As String
Dim MyMail4 As String
Dim recip(5) As Variant

MyMail = Range("AG2").Value
MyMail1 = Range("AG3").Value
MyMail2 = Range("AG4").Value
MyMail3 = Range("AG5").Value
MyMail4 = Range("AG6").Value
recip(0) = "sachin.jain@jcb.com"
recip(1) = "sachin.jain@jcb.com"
recip(2) = MyMail1
recip(3) = MyMail2
recip(4) = MyMail3
recip(5) = MyMail4
Set oSess = CreateObject("Notes.NotesSession")
Set oDB = oSess.GETDATABASE("", "")
Call oDB.OPENMAIL
flag = True
If Not (oDB.IsOpen) Then flag = oDB.Open("", "")
If Not flag Then
MsgBox "Can't open mail file: " & oDB.SERVER & " " & oDB.FILEPATH
GoTo exit_SendAttachment
End If
On Error GoTo err_handler
'Building Message
Set oDoc = oDB.CREATEDOCUMENT
Set oItem = oDoc.CREATERICHTEXTITEM("BODY")
oDoc.Form = "Memo"
oDoc.Subject = "NADRUKORDER"
oDoc.Sendto = recip
oDoc.Body = ""
oDoc.postdate = Date
oDoc.SaveMessageOnSend = True
MyRange = Range("S31").Value
MyRange2 = Range("S32").Value
MyRange3 = Range("S33").Value
MyRange4 = Range("S34").Value
MyRange5 = Range("S35").Value
MyRange6 = Range("S36").Value
'Attaching DATABASE
Set rng = Range("S14")

Call oItem.EmbedObject(1454, "", rng.Value)

Set rng = Range("S32")

While rng.Value <> ""

Call oItem.EmbedObject(1454, "", rng.Value)

Set rng = rng.Offset(1)

Wend
oDoc.visable = True
'Sending Message
oDoc.Send False
exit_SendAttachment:
On Error Resume Next
Set oSess = Nothing
Set oDB = Nothing
Set oDoc = Nothing
Set oItem = Nothing
'Done
Exit Sub
err_handler:
If Err.Number = 7225 Then
MsgBox "Bestand bestaat niet"
Else
MsgBox Err.Number & " " & Err.Description
End If
On Error GoTo exit_SendAttachment

End Sub