Hello everyone, Been toiling away getting this code working to create and send emails through IBM Lotus Notes, and it works Perfectly!...
Except for this one annoying damn thing.
The code does everything EXCEPT close the email after it sends, which is a issue because if it batch sends 50 emails, that leaves 50 tabs to close which might even crash lotus as its such a P.O.S.
Heres my code, does anyone know of a command to close the email after its sent?
Code:
Public Function Send_Email()
'Complied Pro Publico Bono by DahulŪ
Dim MyDB As DAO.Database
Dim MyRS As DAO.Recordset
Dim strSQL As String
Dim Notes As Object
Dim Maildb As Object
Dim objNotesDocument As Object
Dim objNotesField As Object
Dim mysubject As String
Dim mysendto As String
Dim myBody As String
strSQL = "Select * From [Police Departments Query];"
Set MyDB = CurrentDb
Set MyRS = MyDB.OpenRecordset(strSQL, dbOpenDynaset)
With MyRS
.MoveFirst
Do While Not MyRS.EOF
mysubject = "Thank You Letter for Officer " & ![Officer Name]
mysendto = ![Email] 'or you can use Me.txtemail for example
'myBody =
Set Notes = CreateObject("Notes.NotesSession")
Set Maildb = Notes.GETDATABASE("", "")
Call Maildb.OPENMAIL
Set objNotesDocument = Maildb.createdocument
Set objNotesField = objNotesDocument.appenditemvalue("Subject", mysubject)
Set objNotesField = objNotesDocument.appenditemvalue("SendTo", mysendto)
Set objNotesField = objNotesDocument.createrichtextitem("Body")
Call objNotesDocument.REPLACEITEMVALUE("", , "Body", myBody)
'here's the attaching bit
objNotesField = objNotesField.EMBEDOBJECT(1454, "", [Path to PDF])
Set Workspace = CreateObject("Notes.NotesUIWorkspace")
Call Workspace.EDITDOCUMENT(True, objNotesDocument)
Dim UIdoc As Object
Set UIdoc = Workspace.CURRENTDOCUMENT
Call UIdoc.GOTOFIELD("Body")
Body1 = "Attached is a thank you letter for Officer " & ![Officer Name] & " for using a Automated External Defibrillator on " & ![Date of Incident] & ". Could you please see that the Officer gets it? Thank you."
Call UIdoc.InsertText(Body1)
'Insert some carriage returns at the end of the email
Call UIdoc.InsertText(vbCrLf & vbCrLf)
Call UIdoc.Send(False)
Set session = Nothing
.MoveNext
Loop
End With
MyRS.Close
Set MyRS = Nothing
MsgBox "Emails have been Sent", vbOKOnly, "Operation Completed"
End Function