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