Sending email through Lotus notes 6 via VB

[Itopa]

Pls does any one has the code snippet for sending email with attchment through Lotus notes R6 with VB. I need help

 

[Kadanis]

Hi

I picked this up a few years ago and used it successfully through to Lotus Notes 5.5. I cant & wont take credit, however I don't remember where I got it so if the original author sees it here please don't take offence. It has been modified a bit.

Can't guarantee it'll work with LN6 as I haven't worked with that yet but give it a go.

Please note: The error code at the bottom only picks up addresses from the internal mail not internet mail

Public strAttachement As Boolean
Public Function SendNotesMail(Subject As String, Attachment As String, recipient As String, BodyText As String, SaveIt As Boolean, RtnRec As String)
On Error GoTo EmailError:

'Set up the objects required for Automation into lotus notes
Dim mailDb As Object 'The mail database
Dim UserName As String 'The current users notes name
Dim MailDbName As String 'The current users notes mail database name
Dim mailDoc As Object 'The mail document itself
Dim AttachME As Object 'The attachment richtextfile object
Dim Session As Object 'The notes session
Dim EmbedObj As Object 'The embedded object (Attachment)
'Start a session to notes
Set Session = CreateObject("Notes.NotesSession")
'Get the sessions username and then calculate the mail file name
'You may or may not need this as for MailDBname with some systems you
'can pass an empty string
'UserName = Session.UserName
'MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
'Open the mail database in notes
Set mailDb = Session.GetDatabase("", MailDbName)
If mailDb.ISOPEN = True Then
'Already open for mail
Else
mailDb.OpenMail
End If
'Set up the new mail document
Set mailDoc = mailDb.CreateDocument
With mailDoc
     '.Form = "Memo"
     .SendTo = recipient
     .Subject = Subject
     .Body = BodyText
     .SAVEMESSAGEONSEND = SaveIt
     .PostedDate = Now() 'Gets the mail to appear in the sent items folder
     .ReturnReceipt = RtnRec  'sets the return receipt on or off (0 or 1) value 0 is off.
End With
'Set up the embedded object and attachment and attach it
If strAttachement = True Then
Set AttachME = mailDoc.CreateRichTextItem(Attachment)
Set EmbedObj = AttachME.EmbedObject(1454, "", Attachment, "Attachment")
mailDoc.CreateRichTextItem ("Attachment")
End If
'Send the document
mailDoc.Send 0, recipient
'Clean Up
Set mailDb = Nothing
Set mailDoc = Nothing
Set AttachME = Nothing
Set Session = Nothing
Set EmbedObj = Nothing
Exit Function
EmailError:
Select Case Err
     Case 7294
     MsgBox "The recipient cannot be found in the  Address book. Please verify against Lotus Notes database and update your mail records.", 64 + 0, "E-Mail Address Not Found"
     Case Else
      MsgBox Err.Number & " - " & Err.Description
End Select

End Function

Am I jumping the gun, Baldrick, or are the words 'I have a cunning plan' marching with ill-deserved confidence in the direction of this conversation?

 

[zarkon4]

The following works great for us.

Set a reference to Notes32.tlb (located in lotus notes directory)

'Error Messages
Private Const ERR_SENDTO As String = "Send to email address has not been set."
Private Const ERR_SUBJECT As String = "Subject of email has not been set."
Private Const ERR_FILE As String = "The following attachment file does not exist."

'Error Numbers
Private Const ERR_NO_SENDTO As Long = 10101
Private Const ERR_NO_SUBJECT As Long = 10102
Private Const ERR_NO_FILE As Long = 10103

'Object Declaration
Private mobjSession As Object
Private mobjNotesDB As Object
Private mobjMailDoc As Object
Private mobjAttachment As Object

'Variable Declaration
Private mstrSendTo As String
Private mstrCopyTo As String
Private mstrSubject As String
Private mstrBody As String
Private mstrAttachFile As String
Private mstrSendToArray() As String


Public Property Let SendTo(strSendTo As String)
Dim lCount As Long
If mstrSendTo <> "" Then
lCount = UBound(mstrSendToArray())
ReDim Preserve mstrSendToArray(lCount + 1)
mstrSendToArray(lCount + 1) = strSendTo
Else
mstrSendTo = strSendTo
ReDim mstrSendToArray(1)
mstrSendToArray(1) = strSendTo
End If
End Property

Public Property Let CopyTo(strCopyTo As String)
mstrCopyTo = strCopyTo
mobjMailDoc.CopyTo = mstrCopyTo
End Property

Public Property Let Subject(strSubject As String)
mstrSubject = strSubject
mobjMailDoc.Subject = mstrSubject
End Property

Public Property Let Body(strBody As String)
mstrBody = strBody
Call mobjAttachment.APPENDTEXT(mstrBody)
End Property

Public Property Let Attachment(strFileName As String)
Dim fso As FileSystemObject
mstrAttachFile = strFileName

'ensure the file exists
Set fso = New FileSystemObject
If fso.FileExists(mstrAttachFile) Then
Set fso = Nothing
Call mobjAttachment.EMBEDOBJECT(1454, "", mstrAttachFile)
Else
Set fso = Nothing
Err.Raise ERR_NO_FILE, APP_NAME, ERR_FILE & " " & mstrAttachFile
End If

End Property

Public Function SendMail() As Boolean

On Error GoTo ErrorHandler

'Ensure the Sendto has been set.
If UBound(mstrSendToArray()) < 1 And mstrSendTo = "" Then
SendMail = False
Err.Raise ERR_NO_SENDTO, APP_NAME, ERR_SENDTO
Exit Function
Else
If UBound(mstrSendToArray()) > 1 Then
mobjMailDoc.SendTo = mstrSendToArray()
Else
mobjMailDoc.SendTo = mstrSendTo
End If
End If

'Ensure the Subject line has been set.
If mstrSubject = "" Then
SendMail = False
Err.Raise ERR_NO_SUBJECT, APP_NAME, ERR_SUBJECT
Exit Function
End If

'Save the message in the users sent folder
mobjMailDoc.SAVEMESSAGEONSEND = True

'Send the email
Call mobjMailDoc.SEND(False)
SendMail = True

Exit Function

ErrorHandler:
SendMail = False
Err.Raise Err.Number, APP_NAME, Err.Description

End Function


Private Sub Class_Initialize()
'Instantiate objects
Set mobjSession = CreateObject("Notes.Notessession")
'try setting the server and maybe the db
Set mobjNotesDB = mobjSession.GETDATABASE("", "")
Call mobjNotesDB.OPENMAIL
Set mobjMailDoc = mobjNotesDB.CREATEDOCUMENT
mobjMailDoc.Form = "Memo"
Set mobjAttachment = mobjMailDoc.CREATERICHTEXTITEM("BODY")
End Sub

Private Sub Class_Terminate()
'Cleanup objects
Set mobjSession = Nothing
Set mobjNotesDB = Nothing
Set mobjAttachment = Nothing
Set mobjMailDoc = Nothing
End Sub

 

[Itopa]

May God Almighty bless the founders of this tek-tips. It has made me very productive at work. i get job done so fast and efficiently. It is highly useful