Sub emailer()

'Code to email RCR

    With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
    End With

TodaysDate = Date
    ActiveWorkbook.SaveAs ("C:\Documents and Settings\" & Environ("username") & "\My Documents\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 = "C:\Documents and Settings\" & Environ("username") & "\My Documents\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("Additional information").Range("a31").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
        MailDoc.SaveMessageOnSend = True
        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:
MailDoc.SaveMessageOnSend = True
    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