Help with Lotus Notes code

[daz2000]

Hi,

I have got some code to work to send out emails with attachments from an access database, all works fine, however I can't get the messages to save in my sentbox.

Can someone look at my code and point me in the right direction.

-----------------------------------------------
Function CreateNotesMemo(sBodyText() As String, sSubject As String, sAddr() As String, sAttach() As String) As Long
Dim Maildb As Object
Dim MailDoc As Object
Dim Body As Object
Dim Session As Object
Dim objNotesSession As Object
Dim objNotesMailFile As Object
Dim objNotesDocument As Object
Dim objNotesField As Object
Dim sendmail As Boolean
Dim ntsserver As String, ntsmailFile As String
Dim osess As Object
Dim iloop As Integer
Dim strTextName As String
Dim iErrs As Integer
On Error GoTo err_CreateNotesMemo

Set osess = CreateObject("Notes.NotesSession")
ntsserver = osess.GetEnvironmentString("MailServer", True)
ntsmailFile = osess.GetEnvironmentString("MailFile", True)
'Start a session to notes
Set objNotesSession = CreateObject("Notes.NotesSession")
Set objNotesMailFile = objNotesSession.GETDATABASE(ntserver, ntsmailFile)
Set objNotesDocument = objNotesMailFile.CREATEDOCUMENT
'Subject line
Call objNotesDocument.APPENDITEMVALUE("Subject", sSubject)
'Recipient
For iloop = LBound(sAddr) To UBound(sAddr)
If iloop = LBound(sAddr) Then
iErrs = 0
strTextName = "SendTo"
Call objNotesDocument.APPENDITEMVALUE(strTextName, sAddr(iloop))
Else
iErrs = 0
strTextName = "CopyTo"
Call objNotesDocument.APPENDITEMVALUE(strTextName, sAddr(iloop))
End If
Next iloop
iErrs = 0
'Body
Set Body = objNotesDocument.CREATERICHTEXTITEM("Body")
For iloop = LBound(sBodyText) To UBound(sBodyText)
If iloop = LBound(sAddr) Then
Call Body.APPENDTEXT(sBodyText(iloop))
Else
Call Body.APPENDTEXT(vbNewLine & sBodyText(iloop))
End If
Next iloop
'Attachment
If sAttach(LBound(sAttach)) <> "" Then
Set objAttach = objNotesDocument.CREATERICHTEXTITEM("Attachment")
For iloop = LBound(sAttach) To UBound(sAttach)
Set objEmbed = objAttach.EMBEDOBJECT(1454, "", sAttach(iloop), "Attachment")
Next iloop
End If
CreateNotesMemo = 0
With objNotesDocument
.SAVEMESSAGEONSEND = True
.PostedDate = Now()
.SEND 0
End With

exit_CreateNotesMemo:
On Error Resume Next
Set objNotesSession = Nothing
Set objNotesMailFile = Nothing
Set objNotesDocument = Nothing
Set objNotesField = Nothing
Exit Function
err_CreateNotesMemo:
If Err.Number = 7412 Then
iErrs = iErrs + 1
' Allows 10 Tries
If iErrs > 10 Then
On Error GoTo exit_CreateNotesMemo
Else
If Left(strTextName, 5) = "Enter" Then
strTextName = Right(strTextName, Len(strTextName) - 5)
ElseIf Left(strTextName, 7) = "Display" Then
strTextName = Right(strTextName, Len(strTextName) - 7)
End If
Resume
End If
End If
MsgBox Err.Number & " " & Err.Description
On Error GoTo exit_CreateNotesMemo
CreateNotesMemo = Err.Number
End Function
-----------------------------------------------

 

[daz2000]

anyway able to assist on this one?