Using excel to send email through lotus notes - variable data and open/close notes

I am trying to use an excel vba to enter variable data on the body of the email and to open a and close the session with VBA. I have been successful at generating the new session and attaching the file, but I cannot insert the variable data and close the session.

Can anyone help? :banghead:

Below is my code I have so far.

Code:

---

Dim objNotesSession As Object
Dim objNotesMailFile As Object
Dim objNotesDocument As Object
Dim objNotesField As Object

Function SendMail()
    Msg10 = "Test"
    On Error GoTo SendMailError
    EMailSendTo = "rick.roach@maps-na.com" '' Required - Send to address
    EMailCCTo = ""                      '' Optional
    EMailBCCTo = ""                    '' Optional
    ' Establish Connection to Notes
    Set objNotesSession = CreateObject("Notes.NotesSession")
    ' Provide password if logged out
    Call Session.Initialize("krroach")
    ' Establish Connection to Mail File
    ''                                    .GETDATABASE("SERVER", "FILE")
    Set objNotesMailFile = objNotesSession.GETDATABASE("", "")
    ' Open Mail
    objNotesMailFile.OPENMAIL
    ' Create New Memo
    Set objNotesDocument = objNotesMailFile.CREATEDOCUMENT
    ' Create 'Subject Field'
    Set objNotesField = objNotesDocument.APPENDITEMVALUE("Subject", EmailSubject)
    ' Create 'Send To' Field
    Set objNotesField = objNotesDocument.APPENDITEMVALUE("SendTo", EMailSendTo)
    ' Create 'Copy To' Field
    Set objNotesField = objNotesDocument.APPENDITEMVALUE("CopyTo", EMailCCTo)
    ' Create 'Blind Copy To' Field
    Set objNotesField = objNotesDocument.APPENDITEMVALUE("BlindCopyTo", EMailBCCTo)
    ' Create 'Body' of memo
    Set objNotesField = objNotesDocument.CREATERICHTEXTITEM("Body")
    With objNotesField
        .APPENDTEXT "This e-mail is generated by an automated process - this is a test."
        .ADDNEWLINE 1
        .APPENDTEXT "Please follow established contact procedures should you have any questions."
        .ADDNEWLINE 2
        .APPENDTEXT "PROCESS INSTABILITY ALERT"
        .ADDNEWLINE 3
        .APPENDTEXT Msg10
        .ADDNEWLINE 4
        .APPENDTEXT "PART NON-CONFORMANCE ALERT"
        .ADDNEWLINE 5
    End With
    ' Attach the file  --1454 indicate a file attachment
    ' objNotesField = objNotesField.EMBEDOBJECT(1454, "", "C:\Temp\test.xls")
    objNotesField = objNotesField.EMBEDOBJECT(1454, "", ActiveWorkbook.FullName)
    'Send the e-mail
    objNotesDocument.Send (0)
    ' Release storage
    Set objNotesSession = Nothing
    Set objNotesSession = Nothing
    Set objNotesMailFile = Nothing
    Set objNotesDocument = Nothing
    Set objNotesField = Nothing
    ' Set return code
    SendMail = True
    Exit Function
    SendMailError:
    Msg = "Error # " & Str(Err.Number) & " was generated by " _
    & Err.Source & Chr(13) & Err.Description
    MsgBox Msg, , "Error", Err.HelpFile, Err.HelpContext
    SendMail = False
End Function

---

Thanks in advance for any help.

Rick

Rick,
This is what I do but I am unable to attach a spreadsheet.

Code:

---

Call CreateLotusWorkSpace
    wsEmailBody.Activate
    ' strNameTo = EmailTO
    strNameTo = ""
    strNameCC = EmailCC
    Call SendEmail(strNameTo, strNameCC, FName)
    Call CloseLotusWorkSpace

Public Sub CreateLotusWorkSpace()
    Dim lnRetVal As Long
    ' Check if Lotus Notes is open or not.
    lnRetVal = FindWindow("NOTES", vbNullString)
    If lnRetVal = 0 Then
        MsgBox "Please make sure that Lotus Notes is open!", vbExclamation
        Exit Sub
    End If
    ' Instantiate the Lotus Notes COM's objects.
    Set oWorkSpace = CreateObject("Notes.NotesUIWorkspace")
End Sub

Public Sub CloseLotusWorkSpace()
    ' Release objects from memory.
    Set oWorkSpace = Nothing
    Set oUIDoc = Nothing
End Sub

Sub SendEmail(stTo As String, stCC As String)
    Dim stBody As String
    Dim stSubject As String
    Dim rnBody As Range
    Dim lnRetVal As Long
    stBody = ""
    stSubject = "Daily Report"
    ' A named range in the activesheet is in use.
    Set rnBody = ActiveSheet.Range("A1:A22")
    rnBody.Copy
    ' Using LotusScript to create the e-mail.
    Set oUIDoc = oWorkSpace.COMPOSEDOCUMENT("", "", "Memo")
    Set oUIDoc = oWorkSpace.CURRENTDOCUMENT
    Call oUIDoc.FIELDSETTEXT("EnterSendTo", stTo)
    Call oUIDoc.FIELDSETTEXT("EnterCopyTo", stCC)
    Call oUIDoc.FIELDSETTEXT("Subject", stSubject)
    Call oUIDoc.FIELDSETTEXT("Body", stBody)
    Call oUIDoc.GOTOFIELD("Body")
    Call oUIDoc.Paste
    Call oUIDoc.EMBEDOBJECT(1454, "", ActiveSheet.Range("C1:C1"))
    Call oUIDoc.Send
    Call oUIDoc.Close
    With Application
        .CutCopyMode = False
        .ScreenUpdating = True
    End With
End Sub

---

Welcome both of you to the forum!

Please add code tags around code. You can click the # icon and paste between tags.

Here is how I do it.

Code:

---

Sub test()
    Dim lErr As ErrObject
    SendNotesMail _
    "PMP Handbook5", "c:\t.pdf", _
    "krhobson@odot.org, krhobson@aaahawk.com", _
    "Click file: " & vbCrLf & _
    "file://u:\Material\pmp\PMP%20Handbook.pdf" & vbCrLf & _
    "or, open the attachement.", , lErr
    If lErr.Number <> 0 Then MsgBox lErr.Number & vbCrLf & lErr.Description
  End Sub

' Escape characters, %20=space, http://everything2.com/node/1350052
' Similar to: Brian Walters, http://www.ozgrid.com/forum/showthread.php?t=67089
Public Sub SendNotesMail(Subject As String, Attachment As String, _
    ByVal Recipient As String, _
    BodyText As String, _
    Optional SaveIt As Boolean = True, _
    Optional ByRef lErr As ErrObject)
    ' lErr is used when using the Sub in a batch process,
    ' to handle instances where an error appears
    ' Example of use:
    ' SendNotesMail "The Subject", "C:\My Documents\TestFile.txt", _
    "john@doe.com, jane@doe.com", _
    ' This is the body text, can be longer", True, lErr
    ' Set up the objects required for Automation into lotus notes
    Dim Maildb As Object            'The mail database
    Dim UserName As String          'The current users notes 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 ArRecipients() As String    'Array of recipients
    Dim i As Long                  'Counter
    Dim oBody As Object            'Body of text in for rich text format
    ' Early Bind - Tools > Reference > Lotus Notes Automation Classes, notes32.tlb
    ' Dim ln As lotus.NOTESSESSION
    ' Set ln = CreateObject("Notes.NotesSession")
    ' Dim db As lotus.NOTESDATABASE
    ' Set db = ln.GETDATABASE("", "mail\username.nsf")
    ' Dim mDoc As lotus.NOTESDOCUMENT
    ' Set mDoc = db.CREATEDOCUMENT
    ' Create an array of recipients (Separated by commas)
    Recipient = Recipient & ","
    While InStr(1, Recipient, ",", 1) > 0
        i = i + 1
        ReDim Preserve ArRecipients(1 To i) As String
        ArRecipients(i) = _
        Left(Recipient, InStr(1, Recipient, ",", 1) - 1)
        Recipient = _
        Mid(Recipient, InStr(1, Recipient, ",", 1) + 1, Len(Recipient))
    Wend
    ' Start a session to notes
    Set Session = CreateObject("Notes.NotesSession")
    On Error GoTo err_h
    ' Open the mail database in notes
    Set Maildb = Session.GETDATABASE("", "mail\username.nsf")
    If Maildb.IsOpen = False Then
        Maildb.OPENMAIL
    End If
    ' Set up the new mail document
    Set MailDoc = Maildb.CREATEDOCUMENT
    MailDoc.Form = "Memo"
    MailDoc.sendto = ArRecipients
    MailDoc.Subject = UCase(Subject)
    ' MailDoc.Body = UCase(BodyText)
    Set oBody = MailDoc.CREATERICHTEXTITEM("Body")
    oBody.APPENDTEXT BodyText
    ' This is supposed to be the property, but works
    ' on some systems only
    ' without an apparent reason of failure
    MailDoc.SAVEMESSAGEONSEND = SaveIt
    ' Set up the embedded object and attachment and attach it
    If Attachment <> "" Then
        Set AttachME = MailDoc.CREATERICHTEXTITEM("Attachment")
        Set EmbedObj = AttachME.EMBEDOBJECT(1454, "", Attachment, "Attachment")
    End If
    ' Send the document
    MailDoc.PostedDate = Now() 'Gets the mail to appear in the sent items folder
    MailDoc.Send 0
    MailDoc.Save True, True, False
    ' Clean Up
    err_h:
    Set lErr = Err
    Set Maildb = Nothing
    Set MailDoc = Nothing
    Set AttachME = Nothing
    Set Session = Nothing
    Set EmbedObj = Nothing
End Sub

---