Lotus Notes Email (I know... not again!)

Private Sub Close_Click()
On Error GoTo Err_Close_Click

Dim stMacName As String
Dim strBody As String

'if the user opens the record and closes it without entering data, close the record without sending an email.
If strBody = Nz(Me.whatever field you want.Value) Then
DoCmd.close
Else

DoCmd.RunCommand acCmdSaveRecord 'I have some mandetory (isnotnull) fields so this tries to save the record if someone tries to close the record without entering all mandetory data. The save fails and they are requested to enter the data - omit this if you have no mandetory fields

'warning message that LNotes must be running for the email send to work
MsgBox "SEND EMAIL: Lotus Notes must be active to send an email. If Lotus Notes is NOT running and you click OK, the eMail will NOT be sent.", vbCritical

'this function is in your Lotus Notes Module
strBody = "This is an emergency change. Please Authorise:" 'you can use your fields in the strBody if you wish me.xxxxxxx

    Call SendLotus(strBody, Me.Group.Value) 'uses the value of the Group combox

DoCmd.close
End If

Exit_Close_Click:
    Exit Sub

Err_Close_Click:
    MsgBox err.Description
    Resume Exit_Close_Click
    
End Sub

Sub SendLotus(strBody As String, strGroup As String)
Dim S As Object
Dim db As Object
Dim doc As Object
Dim rtItem As Object
'Dim LIST1 As String 'use this if you want to send to one person
Dim Server As String, Database As String
Dim strError As String
Dim stDocName As String
Dim myarray As Variant


    Select Case strGroup 'if you add people, remember to increase the array number accordingly
        Case "Group1" 
            ReDim myarray(1)
            myarray(0) = "email address"
            myarray(1) = "email address"
        Case "Group2" 
            ReDim myarray(1)
            myarray(0) = "email address"
            myarray(1) = "email address"
        Case "Group3" 
            ReDim myarray(1)
            myarray(0) = "email address"
            myarray(1) = "email address"
        Case "Group4" 
            ReDim myarray(2)
            myarray(0) = "email address"
            myarray(1) = "email address"
            myarray(2) = "email address"
        Case "Group5" 
            ReDim myarray(2)
            myarray(0) = "email address"
            myarray(1) = "email address"
            myarray(2) = "email address"
        Case "Group6" 
            ReDim myarray(2)
            myarray(0) = "email address"
            myarray(1) = "email address"
            myarray(2) = "email address"
        Case Else 
            ReDim myarray(1)
            myarray(0) = "email address"
            myarray(1) = "email address"
    End Select
    

'LIST1 = "email address" 'easier if you want to send to one person

' start up Lotus Notes and get object handle
Set S = CreateObject("Notes.NotesSession")
Server = S.GETENVIRONMENTSTRING("MailServer", True)
Database = S.GETENVIRONMENTSTRING("MailFile", True)
Set db = S.GetDatabase(Server, Database)

On Error GoTo ErrorLogon
' See if user is logged on yet;
' if not, the error handler will
' kick in!
Set doc = db.CreateDocument
On Error GoTo 0

doc.Form = "Memo"
doc.Importance = "1" '(WHERE 1=URGENT, 2= NORMAL, 3=FYI)

'Send an EMail to
doc.sendto = myarray
'SENDS A RETURN RECIEPT
'doc.RETURNRECIEPT = "1"
doc.Subject = "Emergency Change"

' this will build the text part of your mail message

Set rtItem = doc.CreateRichTextItem("Body")
'Call rtItem.AppendText("This email was generated automatically" & vbCrLf & "An Emergency Change has been entered")
Call rtItem.AppendText(strBody)
Call rtItem.ADDNEWLINE(1)
'doc.SaveMessageOnSend = True 'to Save in Sent Folder
Call doc.Send(False) 'Make sure this parameter stays false

' set all object handles to nothing to release memory
Set doc = Nothing
Set db = Nothing
Set S = Nothing
Set rtItem = Nothing


MsgBox "an eMail has been sent for authorisation.", vbInformation

Exit Sub

ErrorLogon:
If err.Number = 7063 Then
MsgBox "Please login to Lotus Notes first and then click the 'send' button in the Change Management database", vbCritical
Set doc = Nothing
Set db = Nothing
Set S = Nothing
Set rtItem = Nothing

Exit Sub
Else
strError = "There was an error in your system:" & vbCrLf
strError = strError & "Err. Number: " & err.Number & vbCrLf
strError = strError & "Description: " & err.Description
MsgBox strError, vbCritical
Set doc = Nothing
Set db = Nothing
Set S = Nothing
Set rtItem = Nothing

Exit Sub
End If

End Sub