lotus notes from Access

M

Miskacee

I am having a problem with the subject line. I have a program with several
emails going out at once from an Access program. However, I have been asked
to change the subject line for each email recipient. do you know what I am
missing in the code? I've identified where my error is located below.

Public Function SendEmailToUsers()
On Error GoTo sendErr

'Recordset to hold emails
Dim s As Integer
Dim C As Integer
Dim bc As Integer
Dim rsEmails As Recordset
Dim rsBEmail As Recordset
Dim rsTEmails As DAO.Recordset
Dim rsAttach As DAO.Recordset
Dim dbTE As DAO.Database
Dim rsAddBook As DAO.Recordset

'SQL String to create recordsets
Dim sSql As String
Dim ySql As String
Dim bSql As String
Dim arSQL As String
Dim rsASQL As String

'Notes object declarations
Dim strCurrentPath As String
Dim notesdb As Object
Dim notesdoc As Object
Dim notesrtf As Object
Dim notessession As Object

'Recipients Arrays
Dim ArSendToRecipients(10) As String
Dim ArCopyToRecipients(100) As String
Dim ArsubjectToRecipients(255) As String
Dim response
'''''''''''''''''''''''
Set dbTE = CurrentDb
dbTE.TableDefs.Refresh
'Build recipient lists for Notes object
' Set rsAddBook = dbTE.OpenRecordset("SELECT emailaddress, subject FROM
tbl_managerEmail ")
s = 0
C = 0
sb = 0
If rsAddBook.BOF = False Then
rsAddBook.MoveFirst
Do Until rsAddBook.EOF
****************************this is where the error lies
**********************
' strAppend = rsAddBook!AppendTo
Select Case LCase(strAppend)
Case "sendto"
ArSendToRecipients(s) = rsAddBook!EmailAddress
s = s + 1
Case "copyto"
ArCopyToRecipients(C) = rsAddBook!EmailAddress
C = C + 1
Case "subject"
ArsubjectToRecipients(bc) = rsAddBook!subject
sb = bc + 1
End Select
rsAddBook.MoveNext
Loop
End If

EndEmailAssignments:
Set notessession = CreateObject("Notes.Notessession")
Set notesdb = notessession.getdatabase("", "")
Call notesdb.openmail
Rem make new mail message
Set notesdoc = notesdb.createdocument

Call notesdoc.replaceitemvalue("Sendto", ArSendToRecipients)
Call notesdoc.replaceitemvalue("Copyto", ArCopyToRecipients)
Call notesdoc.replaceitemvalue("subject", ArsubjectToRecipients)

Set notesrtf = notesdoc.createrichtextitem("body")
Call notesrtf.addnewline(2)
Call notesrtf.appendtext(Forms!frm_AddressBook!txtEmail)
Call notesrtf.addnewline(2)
On Error Resume Next

Rem attach Error Report doc
's = ActiveDocument.Path + "\" + ActiveDocument.Name
notesdoc.SaveMessageOnSend = True
notesdoc.Visible = True
Call notesdoc.Send(False)
MsgBox "Email sent to selected user's successfully.", vbExclamation,
"Email Sent Successfully!"
Exit_notifyRequestor:
dbTE.Close
Set dbTE = Nothing
Set notessession = Nothing
Set rsTEmails = Nothing
Set dbTE = Nothing
Set rsAddBook = Nothing
Set notesdb = Nothing
Set notesdoc = Nothing
Set notesrtf = Nothing
Set notessession = Nothing
ArSendToRecipients(10) = Empty
ArCopyToRecipients(100) = Empty
ArsubjectToRecipients(255) = Empty
s = Empty
B = Empty
sb = Empty
Exit Function

sendErr:
MsgBox Err.Description
Resume Exit_notifyRequestor

End Function
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top