Saving emails sent by Lotus Notes through Excel

[cdb]

I have a spreadsheet with some coding in it to send an email via Lotus Notes.
This all works fine to send, but I am having a slight problem with part of it.

As a workaround to sending to multiple people (instead of using checkboxes
etc) I just put a loop in to action on the result of a message box, so after
the first sending a message box pops up asking if they want to send to
another recipient, and if so loops through the code again. This all works
fine, apart from the fact that when I check my Sent box in Lotus Notes it
only saves the latest email sent, and not all of them.

Is there anything I can do to correct this, and get it saving all the emails
sent?

My code is as follows:

Sub emailer()

With application
.ScreenUpdating = False
.DisplayAlerts = False
End With

TodaysDate = Date
ActiveWorkbook.SaveAs ("U:\Recruitment Campaign Request " &
Sheets("Summary").Range("C10").Value & ", " &
Sheets("Summary").Range("C57").Value & " " & Left(TodaysDate, 2) & "-" &
Mid(TodaysDate, 4, 2) & "-" & Right(TodaysDate, 4) & ".xls")
savedworkbook = "U:\Recruitment Campaign Request " &
Sheets("Summary").Range("C10").Value & ", " &
Sheets("Summary").Range("C57").Value & " " & Left(TodaysDate, 2) & "-" &
Mid(TodaysDate, 4, 2) & "-" & Right(TodaysDate, 4) & ".xls"
If ActiveWorkbook.Saved = False Then GoTo ExitSub
On Error GoTo ExitSub

user = application.UserName
Mid(user, 1, 1) = UCase(Mid(user, 1, 1))
For counter = 1 To Len(user)
If Mid(user, counter, 1) = "." Then
Mid(user, counter, 1) = " "
Mid(user, counter + 1, 1) = UCase(Mid(user, counter + 1, 1))
End If
Next counter

' Declare Variables for file and macro setup
Dim UserName As String
Dim MailDbName As String
Dim Maildb As Object
Dim MailDoc As Object
Dim AttachME As Object 'Attachment bit
Dim Session As Object
Dim EmbedObj1 As Object 'Attachment bit

Set Session = CreateObject("Notes.NotesSession")
UserName = Session.UserName
Set Maildb = Session.GETDATABASE("", MailDbName)
If Maildb.IsOpen = True Then
Else
Maildb.OPENMAIL
End If

Maildb.CreateDocument

Set MailDoc = Maildb.CreateDocument
MailDoc.Form = "Memo"
MailDoc.from = Sheets("Summary").Range("C6").Value
MailDoc.Subject = Sheets("Summary").Range("C8").Value & " RCR Request: "
& Sheets("Summary").Range("C10").Value & ", " &
Sheets("Summary").Range("C57").Value
MailDoc.principal = Sheets("Summary").Range("C6").Value
MailDoc.Body = "" 'Sheets("email wording").Range("a1").Value

attachment1 = savedworkbook
'Attachment bit
Set AttachME = MailDoc.CREATERICHTEXTITEM("attachment1")
Set EmbedObj1 = AttachME.embedobject(1454, "attachment1",
attachment1, "")
application.ScreenUpdating = True
'End Attachment bit

MailDoc.SaveMessageOnSend = True

On Error GoTo 0

sent = False

SendBit:
MailDoc.SaveMessageOnSend = True
While sent = False
On Error GoTo IncorrectAddressee
emailto = InputBox("Please enter the Lotus Notes name of who you
would like to send the RCR to:" & vbNewLine & "(Please remember that the RCR
will need authorisation first)", "Email Addressee", "") '"Enter Details
Here....")
If emailto = Cancel Then Exit Sub
MailDoc.SendTo = emailto 'Sheets("email wording").Range("a2").Value

Call MailDoc.Send(False)
If ErrorMessage1 = "" Then
sent = True
ErrorMessage1 = ""
Else
sent = False
ErrorMessage1 = ""
End If
MailDoc.SaveMessageOnSend = True
GoTo sentok
IncorrectAddressee:
ErrorMessage1 = MsgBox("This form has not been submitted. Please
check the Lotus Notes name of the recipient and try again.", vbOKOnly,
"Incorrect Lotus Notes name")
Resume Next
sentok:
Wend
MoreRecipients = MsgBox("Would you like to add another recipient?", vbYesNo,
"Multiple Recipients")
If MoreRecipients = vbYes Then
sent = False
GoTo SendBit
Else
MessageSent = MsgBox("Your email has now been successfully sent", vbOKOnly,
"Email Success")
End If
Exit Sub

ExitSub:
MsgBox ("This form has not been submitted. Please fill in all the
required fields and try again.")

application.ScreenUpdating = True
application.DisplayAlerts = True
Exit Sub

End Sub

Ta,

cdb

 

[steve_doc]

Excert from my code for a Lotus Notes application

With noDocument
.Form = "Memo"
.SendTo = vaRecipients
.Subject = stSubject
.Body = vaMsg
.SaveMessageOnSend = True <<<<<<
.PostedDate = Now()
.send 0, vaRecipients
End With

HTH

 

[cdb]

Cheers for this, but I already have the 'SaveMessageOnSend = True' line of
code in my code. This does save the email, but it only saves the last one
(whereas, as the code loops through I'd like it to save each email sent,
instead of overwriting the existing one with the new data)

 

[steve_doc]

Out of intrest, while stepping through your code, does it still only save the
last email sent?

Trying to delve into your code, it looks like you are sending 1 email to
multiple parties (please correct me if I am wrong). The way I approached this
is slightly different -- Abrieviated code Below

Set noSession = CreateObject("Notes.NotesSession")
Set noDatabase = noSession.GETDATABASE("", "")

'If Lotus Notes is not open then open the mail-part of it.
If noDatabase.IsOpen = False Then noDatabase.OPENMAIL

Do Until IsEmpty(rg)

AppName = rg.Offset(0, 3)
vaMsg = "some message here"

vaRecipients = rg.Offset(0, 2)

'Create the e-mail and add the attachment.
Set noDocument = noDatabase.CreateDocument

'Add values to the created e-mail main properties.
With noDocument
.Form = "Memo"
.SendTo = vaRecipients
.Subject = stSubject
.Body = vaMsg
.SaveMessageOnSend = True
.PostedDate = Now()
.send 0, vaRecipients
End With

IncreaseRange:
Set rg = rg.Offset(1, 0)
vaMsg = ""
Loop


MsgBox ("The e-mails have successfully been created and distributed."),
vbInformation

ExitSub:
'Release objects from memory.
Set noEmbedObject = Nothing
Set noAttachment = Nothing
Set noDocument = Nothing
Set noDatabase = Nothing
Set noSession = Nothing

Set rg = Nothing
Set wsSheet = Nothing
Set wb = Nothing

Exit Sub

Error_Handling:

MsgBox "Error number: " & Err.Number & vbNewLine & _
"Description: " & Err.Description, vbOKOnly

Resume ExitSub

the above works from me in what I need to do, and saves a copy of each email
sent.
I appreciate that what you are trying to achieve is not the same as what I
am, but feel free to set up a test with my code and modify to fit yours

HTH

 

[cdb]

When I step through it, it saves the current one, until the next one is sent
overwriting it with that one and so on.

Cheers for the code - will give it a look at work tomorrow.