Automated Email w/ Lotus Notes

[Chris Miller]

I am having a problem with sending email from Access97. If
I start Access and update the data and then try to email a
report based on that data, my newest changes don't show up
on the emailed report. I tried using a recordset instead
and generated the text of the email with a while loop, but
that gave the same result. In the code below, debug.print
does print out the correct information, but somehow the
variable Message gets changed when I try to email it.

Debug.Print Message
DoCmd.SendObject acSendNoObject, , acFormatRTF, Recipient,_
, , "Audit Report", Message, 0

[Ben O'Hara]

I'm not sure why your data isn't updating. You could try using
docmd.save to save the form before you send your eamil, or you could
try this code. I've used it extensively. Save your report to an rtf
file then use the code to create the mail. One day I'll get round to
putting a class wrapper round it, but it works pretty good now.

Option Compare Database
Option Explicit

Private Declare Function apiFindWindow Lib "user32" Alias _
"FindWindowA" (ByVal strClass As String, _
ByVal lpWindow As String) As Long

Private Declare Function apiSendMessage Lib "user32" Alias _
"SendMessageA" (ByVal hwnd As Long, ByVal msg As Long, ByVal _
wParam As Long, lParam As Long) As Long

Private Declare Function apiSetForegroundWindow Lib "user32" Alias _
"SetForegroundWindow" (ByVal hwnd As Long) As Long

Private Declare Function apiShowWindow Lib "user32" Alias _
"ShowWindow" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long

Private Declare Function apiIsIconic Lib "user32" Alias _
"IsIconic" (ByVal hwnd As Long) As Long

Function SendNotesMail(strTo As String, strSubject As String, strBody
As String, strFilename As String, ParamArray strFiles())
Dim doc As Object 'Lotus NOtes Document
Dim rtitem As Object '
Dim Body2 As Object
Dim ws As Object 'Lotus Notes Workspace
Dim oSess As Object 'Lotus Notes Session
Dim oDB As Object 'Lotus Notes Database
Dim x As Integer 'Counter
'use on error resume next so that the user never will get an error
'only the dialog "You have new mail" Lotus Notes can stop this
macro
Do While fIsAppRunning = False
MsgBox "Lotus Notes is not running" & Chr$(10) & "Make sure Lotus
Notes is running and press OK."
Loop

On Error Resume Next

Set oSess = CreateObject("Notes.NotesSession")
'access the logged on users mailbox
Set oDB = oSess.GETDATABASE("", "")
Call oDB.OPENMAIL

'create a new document as add text
Set doc = oDB.CREATEDOCUMENT
Set rtitem = doc.CREATERICHTEXTITEM("Body")
doc.sendto = strTo
doc.subject = strSubject
doc.body = strBody & vbCrLf & vbCrLf

'attach files
If strFilename <> "" Then
Set Body2 = rtitem.EMBEDOBJECT(1454, "", strFilename)
If UBound(strFiles) > -1 Then
For x = 0 To UBound(strFiles)
Set Body2 = rtitem.EMBEDOBJECT(1454, "", strFiles(x))
Next x
End If
End If
doc.send False
End Function

Sub test()
Dim strTo As String 'The sendee(s) Needs to be fully qualified
address. Other names seperated by commas
Dim strSubject As String 'The subject of the mail. Can be "" if no
subject needed
Dim strBody As String 'The main body text of the message. Use ""
if no text is to be included.
Dim FirstFile As String 'If you are embedding files then this is
the first one. Use "" if no files are to be sent
Dim SecondFile As String 'Add as many extra files as is needed,
seperated by commas.
Dim ThirdFile As String 'And so on.

strTo = "te...@test.com"
strSubject = "Test Message"
strBody = "This is a test"
strBody = strBody & vbCrLf & "Just add new lines by concatenating
vbCrLF"
FirstFile = "G:\ExcelUtilities.exe"
SecondFile = "G:\life.xls"
ThirdFile = "G:\CompactDbs.vbs"

SendNotesMail strTo, strSubject, strBody, FirstFile, SecondFile,
ThirdFile
End Sub

Private Function fIsAppRunning() As Boolean
'Looks to see if Lotus Notes is open
'Adapted from code by Dev Ashish

Dim lngH As Long
Dim lngX As Long, lngTmp As Long
Const WM_USER = 1024
On Local Error GoTo fIsAppRunning_Err
fIsAppRunning = False

lngH = apiFindWindow("NOTES", vbNullString)

If lngH <> 0 Then
apiSendMessage lngH, WM_USER + 18, 0, 0
lngX = apiIsIconic(lngH)
If lngX <> 0 Then
lngTmp = apiShowWindow(lngH, 1)
End If
fIsAppRunning = True
End If
fIsAppRunning_Exit:
Exit Function
fIsAppRunning_Err:
fIsAppRunning = False
Resume fIsAppRunning_Exit
End Function