SendMail from Access via LNotes (with zipped Attachment)

[MarkusJohn]

Hello Experts,

I thought I have already found what I was looking for, but there seems
to be still something to puzzle over;-)

I wanted to incorporate in Access a Mail functionality that is called
by a query.
Presently this works perfect, mails are send with correct recipients
and subjects and of course attachments.
However if attachments are getting to big, Notes compresses them
automatically and this is my missing bit.

I have copied the part of my VBA code snippet below.
This function get's via parameter list one or more files committed.
This is correctly attached but not compressed.

1) Is there a function that you can call on these files for
compression and how would this function then needs to be changed?

2) If it is not possible with this function perhaps there is another
code module that I can incorporate?

Whatever the solution will be..., I'm happy and thankful for your
advice.

Markus

================================================================================
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

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
================================================================================