Try and use the following Class-module. It will work in conjunction with a Lotus Notes Client. (The UDT QuickMail is to quicken up the use of the class. Put it in the calling class or application.)
UDT:
Public Type QuickMail
Logon As String
OutlookPassword As String
NotesServer As String
Recipients() As String
Subject As String
Body As String
Attachment As String
End Type
E-mail class:
Option Explicit
Private moUserDB As Object
Private moNotesSession As Object
Private moMail As Object
Private mlLoggedOn As Boolean
Private mlHasDraft As Boolean
Private mlWasOpen As Boolean
'--Constants for Lotus Notes mail.
Private Const nNOTES_EMBEDDEDOBJECT = 1454
Private Const nNOTES_ATTACHMENT = 1084
Private Const sNOTES_EMBEDDEDOBJECT = "Attachment"
'///////////////////////////////////////////////////////////////////////////////
'////////////////////////// Public Interface ///////////////////////////////////
'///////////////////////////////////////////////////////////////////////////////
'*******************************************************************************
'* Function : Logon (SUB)
'* Abstract : Logon to the Domino Server.
'*******************************************************************************
Public Sub Logon(Optional ByVal Login As String = vbNullString, _
Optional ByVal Password As String = vbNullString, _
Optional ByVal NotesServer As String = vbNullString)
Dim lSuccess As Boolean
On Error GoTo Err_Logon
Set moNotesSession = GetObject(vbNullString, "Notes.NotesSession"
'-- If Notes was open, don't re-open it.
If Not moNotesSession.CURRENTDATABASE Is Nothing Then
Login = vbNullString
NotesServer = vbNullString
End If
'-- Open appropriate database.
Set moUserDB = moNotesSession.GETDATABASE(NotesServer, Login)
'-- Open mailbox is open, don't re-open.
If Not moUserDB Is Nothing Then
If Not moUserDB.ISOPEN Then
moUserDB.OPENMAIL
End If
lSuccess = True
Else
lSuccess = False
End If
IsLoggedOn = lSuccess
Exit_Logon:
Exit Sub
Err_Logon:
IsLoggedOn = False
GoTo Exit_Logon
End Sub
'*******************************************************************************
' Property: IsLoggedOn
'*******************************************************************************
Public Property Get IsLoggedOn() As Boolean
IsLoggedOn = mlLoggedOn
End Property
'*******************************************************************************
' Property: IsLoggedOn
'*******************************************************************************
Private Property Let IsLoggedOn(ByVal NewValue As Boolean)
mlLoggedOn = NewValue
End Property
'*******************************************************************************
' Property: HasDraft
'*******************************************************************************
Public Property Get HasDraft() As Boolean
HasDraft = mlHasDraft
End Property
'*******************************************************************************
' Property: HasDraft
'*******************************************************************************
Private Property Let HasDraft(ByVal NewValue As Boolean)
mlHasDraft = NewValue
End Property
'*******************************************************************************
'* Function : Logoff (SUB)
'* Abstract : Logoff from the Domino Server.
'*******************************************************************************
Public Sub Logoff()
With Me
If .IsLoggedOn Then
If .HasDraft Then
.DestroyDraft
End If
'-- Close inbox and database.
Call moUserDB.Close
Call moNotesSession.Close
Set moUserDB = Nothing
Set moNotesSession = Nothing
IsLoggedOn = False
End If
End With
End Sub
'*******************************************************************************
'* Function : CreateMail (FUNCTION)
'* Abstract : Create a new mail-message.
'*******************************************************************************
Public Sub CreateMail()
If Me.IsLoggedOn Then
Set moMail = moUserDB.CREATEDOCUMENT
'-- Create mail and set properties.
If Not moMail Is Nothing Then
moMail.Form = "memo"
moMail.SAVEMESSAGEONSEND = True
HasDraft = True
End If
End If
End Sub
'*******************************************************************************
'* Function : Send (FUNCTION)
'* Abstract : Send the created mail, and set posted date to today.
'* This wil make it appear in the send-items.
'*******************************************************************************
Public Function Send() As Boolean
On Error GoTo Err_Send
If Me.HasDraft Then
moMail.PostedDate = Now()
moMail.Send (False)
HasDraft = False
Set moMail = Nothing
End If
Send = True
Exit_Send:
Exit Function
Err_Send:
Send = False
GoTo Exit_Send
End Function
'*******************************************************************************
'* Function : DestroyDraft (SUB)
'* Abstract : Destroy all created, non-send mail.
'*******************************************************************************
Public Sub DestroyDraft()
If Me.HasDraft Then
Set moMail = Nothing
HasDraft = False
End If
End Sub
'*******************************************************************************
'* Function : AddAttachment (FUNCTION)
'* Abstract : Add an attachment to the mail-message.
'*******************************************************************************
Public Function AddAttachment(ByVal FileName As String) As Boolean
Dim oAttachment As Object
Dim oRichText As Object
Dim lSuccess As Boolean
If Me.HasDraft Then
'-- !!! Notes is Object-Oriented !!!
If FileName = vbNullString Then
lSuccess = True
Else
Set oRichText = moMail.CREATERICHTEXTITEM(sNOTES_EMBEDDEDOBJECT)
Set oAttachment = oRichText.EMBEDOBJECT(nNOTES_EMBEDDEDOBJECT, vbNullString, FileName)
lSuccess = Not oAttachment Is Nothing
Set oAttachment = Nothing
Set oRichText = Nothing
End If
Else
lSuccess = False
End If
AddAttachment = lSuccess
End Function
'*******************************************************************************
'* Function : AddSubject (FUNCTION)
'* Abstract : Add a subject to the mail-message.
'*******************************************************************************
Public Function AddSubject(ByVal Subject As String) As Boolean
Dim lSuccess As Boolean
On Error GoTo Err_AddSubject
If Me.HasDraft Then
If Subject = vbNullString Then
lSuccess = True
Else
moMail.Subject = Subject
lSuccess = True
End If
Else
lSuccess = False
End If
AddSubject = lSuccess
Exit_AddSubject:
Exit Function
Err_AddSubject:
AddSubject = False
GoTo Exit_AddSubject
End Function
'*******************************************************************************
'* Function : AddBody (FUNCTION)
'* Abstract : Add the body to the mail-message.
'*******************************************************************************
Public Function AddBody(ByVal Body As String) As Boolean
Dim lSuccess As Boolean
Dim oBody As Object
On Error GoTo Err_AddBody
If Me.HasDraft Then
If Body = vbNullString Then
lSuccess = True
Else
'-- !!! Notes is Object-Oriented !!!
Set oBody = moMail.CREATERICHTEXTITEM("Body"
Call oBody.APPENDTEXT(Body)
Set oBody = Nothing
lSuccess = True
End If
Else
lSuccess = False
End If
AddBody = lSuccess
Exit_AddBody:
Exit Function
Err_AddBody:
AddBody = False
GoTo Exit_AddBody
End Function
'*******************************************************************************
'* Function : GetAttachments (FUNCTION)
'* Abstract : Retrieve attachments from the Inbox.
'*******************************************************************************
Public Function GetAttachments(ByVal Destination As String, _
ByRef Attachments As Collection) As Boolean
Dim oAttachment As Object
Dim oMail As Object
Dim oInbox As Object
Dim oItem As Variant
Dim aValues() As String
Dim lSuccess As Boolean
Dim sFileName As String
On Error GoTo Err_GetAttachments
'-- !!! Notes is Object-Oriented !!!
If Me.IsLoggedOn Then
Set oInbox = moUserDB.GETVIEW("($Inbox)"
Set oMail = oInbox.GETFIRSTDOCUMENT
Do Until (oMail Is Nothing)
Dim colFile As New Collection
colFile.Add Trim(oMail.Subject), "customer"
colFile.Add Trim(oMail.Body), "body"
'-- Loop through all objects on the message-object.
For Each oItem In oMail.Items
If oItem.Type = nNOTES_ATTACHMENT Then
aValues = oItem.Values
Set oAttachment = oMail.GETATTACHMENT(aValues(0))
sFileName = Destination & Trim(aValues(0))
oAttachment.EXTRACTFILE (sFileName)
colFile.Add sFileName, "file"
End If
Attachments.Add colFile, Trim(oMail.Subject)
Set colFile = Nothing
Set oAttachment = Nothing
Next
'-- Remove current first-doc. Get new first doc.
oMail.Remove (True)
Set oMail = oInbox.GETFIRSTDOCUMENT
Loop
oInbox.Refresh
lSuccess = True
Else
lSuccess = False
End If
GetAttachments = lSuccess
Exit_GetAttachments:
Exit Function
Err_GetAttachments:
GetAttachments = False
GoTo Exit_GetAttachments
End Function
'*******************************************************************************
'* Function : AddRecipients (FUNCTION)
'* Abstract : Add recipients to the message. (Can be added as string or array)
'*******************************************************************************
Public Function AddRecipients(ByRef Recipients() As String) As Boolean
Dim lSuccess As Boolean
On Error GoTo Err_AddRecipients
If Me.HasDraft Then
moMail.SendTo = Recipients
lSuccess = True
Else
lSuccess = False
End If
AddRecipients = lSuccess
Exit_AddRecipients:
Exit Function
Err_AddRecipients:
AddRecipients = False
GoTo Exit_AddRecipients
End Function
'****************************************************************************************
'* Function : SendQuickMail (FUNCTION)
'* Abstract : Ability to send message by providing all info. through a user-defined type.
'****************************************************************************************
Public Function SendQuickMail(EMail As QuickMail) As Boolean
Dim lSuccess As Boolean
On Error GoTo Err_SendQuickMail
With Me
.Logon EMail.Logon, , EMail.NotesServer
If .IsLoggedOn Then
.CreateMail
If .HasDraft Then
.AddRecipients EMail.Recipients
.AddSubject EMail.Subject
.AddBody EMail.Body
.AddAttachment EMail.Attachment
.Send
End If
lSuccess = Not .HasDraft
End If
If lSuccess Then
.Logoff
End If
End With
SendQuickMail = lSuccess
Exit_SendQuickMail:
Exit Function
Err_SendQuickMail:
SendQuickMail = False
GoTo Exit_SendQuickMail
End Function
