Edit Lotus Notes emails before they are sent.

I received an email from someone asking for this exact code the day before Klaus sent me this.  Thanks Klaus!

Option Compare Database
Option Explicit

' #####################################################################################

' Author: Klaus Oberdalhoff
' I used several scripts i found on the internet

' Lotus script to open a Lotus eMail and to prefill it with values

' Tested to work with Windows NT 4 and higher NT-Versions (2000 / XP / 2003)
' Tested with Lotus Client 5.07 and higher

' The Lotus client has to be installed
' If a password, different form the NT one is choosen, Lotus has to be open
' in beforehand before this script can be used.

' The idea was, that my clients wants to edit the eMails in beforehand before they are sent.
' And on some applications, the client wants to use the Lotus-address-book to send the data
' though that there is no need, to have the addresses twice in the system.

' I found various scripts showing how to SENT Lotus-emails, but none which just OPENS an
' eMail prefilling the values.

' Using sample:

' Call CreateMailandAttachFileAdr("Subject", "kobd@gmx.de")
' Call CreateMailandAttachFileAdr("Subject", "kobd@gmx.de", "CC@123.com", "BCC@123.com", "C:\Attach1.txt", "C:\Attach2.txt")

' I´ve yet not found out how to prefill the body with richtext (which per se is able to use richtext,
' if you do it interactively). So if you find it out, pls. let me know.

' Klaus Oberdalhoff kobd@gmx.de
' Vers. 1.2 - 1. July 2003

' #####################################################################################

Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long
Declare Function ShowWindow& Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long)

Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Private Function CreateNotesSession&()
Const notesclass$ = "NOTES"
' "Neues Memo - Lotus Notes"
Const SW_SHOWMAXIMIZED = 3
Dim Lotus_Session As Object

Dim rc&
Dim lotusWindow&
Set Lotus_Session = CreateObject("Notes.NotesSession")

DoEvents
DoEvents
lotusWindow = FindWindow(notesclass, vbNullString)
If lotusWindow <> 0 Then
    rc = ShowWindow(lotusWindow, SW_SHOWMAXIMIZED)
    rc = SetForegroundWindow(lotusWindow)
    CreateNotesSession& = True
Else
    CreateNotesSession& = False
End If
End Function

Sub CreateMailandAttachFileAdr(Optional IsSubject As String = "", Optional SendToAdr As String, Optional CCToAdr As String, Optional BCCToAdr As String = "", Optional Attach1 As String = "", Optional Attach2 As String = "")
Const EMBED_ATTACHMENT As Integer = 1454
Const EMBED_OBJECT As Integer = 1453
Const EMBED_OBJECTLINK As Integer = 1452

Dim s As Object ' use back end classes to obtain mail database name
Dim db As Object '
Dim doc As Object ' front end document
Dim beDoc As Object ' back end document
Dim workspace As Object ' use front end classes to display to user
Dim bodypart As Object '

Call CreateNotesSession&

Set s = CreateObject("Notes.Notessession") 'create notes session
Set db = s.getDatabase("", "") 'set db to database not yet named
Call db.Openmail ' set database to default mail database
Set beDoc = db.CreateDocument
Set bodypart = beDoc.CreateRichTextItem("Body")

' Filling the fields
'###################
beDoc.subject = IsSubject
beDoc.SendTo = SendToAdr
beDoc.CopyTo = CCToAdr
beDoc.BlindCopyTo = BCCToAdr

'''''''''''''''''''''''''
''If you want to send a message to more than one person or copy or
''blind carbon copy the following may be of use to you.

'beDoc.sendto = Recipient
'beDoc.CopyTo = ccRecipient
'beDoc.BlindCopyTo = bccRecipient

''Also for multiple email addresses you just set beDoc.sendto (or CopyTo or
''BlindCopyTo) to an array of variants each of which will receive the message. So

'Dim recip(25) as variant
'recip(0) = "emailaddress1"
'recip(1) = "emailaddress2" e.t.c

'beDoc.sendto = recip
''''''''''''''''''''''''

' beDoc.Body = "Hello Mary Lou, Goodbye heart"

' Attaches I
'###########
' Call bodypart.EmbedObject(EMBED_ATTACHMENT, "", DirWithPathFileName, FileName)
If Len(Attach1) > 0 Then
    If Len(Dir(Attach1)) > 0 Then
        Call bodypart.EmbedObject(EMBED_ATTACHMENT, "", Attach1, Dir(Attach1))
    End If
End If

' Attaches II
'############
If Len(Attach2) > 0 Then
    If Len(Dir(Attach2)) > 0 Then
        Call bodypart.EmbedObject(EMBED_ATTACHMENT, "", Attach2, Dir(Attach2))
    End If
End If

Set workspace = CreateObject("Notes.NotesUIWorkspace")

' Positioning Cursor
'###################
' Call workspace.EditDocument(True, beDoc).GotoField("Body")
Call workspace.EditDocument(True, beDoc).GotoField("Subject")

Set s = Nothing

End Sub

[ Email | Access | Main ]