SUBROUTINE AT.SEND.EMAIL.LOTUS(Subject,Attachment,Recipient,BodyText,CC Recipient,BCRecipient,SAVE)
*Bruce Neylon Aug 20, 2004
* This stuff was found in many different places on the web.
*
EQU AM TO CHAR(254), VM TO CHAR(253), SVM TO CHAR(252)
EQU ESC TO CHAR(27), STX TO CHAR(2), CR TO CHAR(13)
EQU EM TO CHAR(25)
*Set up the objects required for Automation into lotus notes
SCRIPT = \Dim Maildatabase\:EM &n bsp; ;*The mail database
SCRIPT := \Dim MailItem\:EM ;*The mail document itself
SCRIPT := \Dim AttachME\:EM ;*The attachment richtextfile object
SCRIPT := \Dim Attachment as string\:EM ;*The attachment richtextfile object
SCRIPT := \Dim MailSession\:EM ;*The notes session
SCRIPT := \Dim EmbedObj\:EM ;*The embedded object (Attachment)
SCRIPT := \Dim Bodytext as string'\:EM
*
RQ = DCOUNT(Recipient,VM)-1
IF RQ < 0 THEN RETURN
SCRIPT := \Dim recip(\:RQ:\) as variant\:EM
*
RQ = DCOUNT(CCRecipient,VM)-1
IF RQ < 0 THEN RQ = 0
SCRIPT := \Dim CCrecip(\:RQ:\) as variant\:EM
*
RQ = DCOUNT(BCRecipient,VM)-1
IF RQ < 0 THEN RQ = 0
SCRIPT := \Dim BCrecip(\:RQ:\) as variant\:EM
*
*Start a session to notes
SCRIPT := \Set MailSession = CreateObject("Notes.NotesSession")\:EM
*
SCRIPT := \Set Maildatabase = MailSession.GETDATABASE("", "mail.box")\:EM
SCRIPT := \If Maildatabase.ISOPEN = True Then\:EM
SCRIPT := \'Already open for mail\:EM
SCRIPT := \Else\:EM
SCRIPT := \Maildatabase.OPENMAIL\:EM
SCRIPT := \End If\:EM
*
*Set up the new mail document
SCRIPT := \Set MailItem = Maildatabase.CREATEDOCUMENT\:EM
SCRIPT := \MailItem.Form = "Memo"\:EM
*
RQ = DCOUNT(Recipient,VM)
FOR RX = 1 TO RQ
SCRIPT := \recip(\:RX-1:\) = "\:Recipient<1,RX>:\"\:EM
NEXT RX
SCRIPT := \MailItem.sendto = recip\:EM
*
IF CCRecipient # '' THEN
RQ = DCOUNT(CCRecipient,VM)
FOR RX = 1 TO RQ
SCRIPT := \CCrecip(\:RX-1:\) = "\:CCRecipient<1,RX>:\"\:EM
NEXT RX
SCRIPT := \MailItem.CopyTo = CCrecip\:EM
END
*
IF BCRecipient # '' THEN
RQ = DCOUNT(BCRecipient,VM)
FOR RX = 1 TO RQ
SCRIPT := \BCrecip(\:RX-1:\) = "\:BCRecipient<1,RX>:\"\:EM
NEXT RX
SCRIPT := \MailItem.BlindCopyTo = BCrecip\:EM
END
*
SCRIPT := \MailItem.Subject = "\:Subject:\"\:EM
*
* For multi line messages
QT = DCOUNT(BodyText,VM)
SCRIPT := \BodyText = "\:BodyText<1,1>:\" & vbCrLf\:EM
FOR XT = 2 TO QT
SCRIPT := \BodyText = BodyText & "\:BodyText<1,XT>:\" & vbCrLf\:EM
NEXT XT
SCRIPT := \MailItem.Body = BodyText\:EM
*
* This will stick the message into your send box
SCRIPT := \MailItem.SAVEMESSAGEONSEND = 1\:EM
*
*Allow for multiple attachemnts
IF Attachment # "" THEN
QD = DCOUNT(Attachment,VM)
FOR XD = 1 TO QD
SCRIPT:= \Attachment = "\:Attachment<1,XD>:\"\:EM
SCRIPT := \Set AttachME = MailItem.CREATERICHTEXTITEM(Attachment)\:EM
SCRIPT := \Set EmbedObj = AttachME.EMBEDOBJECT(1454,"", "\:Attachment<1,XD>:\")\:EM
NEXT XD
END
* *Send the document
SCRIPT := \MailItem.SEND \:SAVE:EM
*Clean Up
SCRIPT := \Set Maildatabase = Nothing\:EM
SCRIPT := \Set MailItem = Nothing\:EM
SCRIPT := \Set AttachME = Nothing\:EM
SCRIPT := \Set MailSession = Nothing\:EM
SCRIPT := \Set EmbedObj = Nothing\:EM
PRINT ESC : STX : 'P' : SCRIPT : CR :
RETURN
|