VBA Array to Lotus Notes email Looping Problem

Hello! I hope there is someone out there who can shed some light on
this for me. I have a module that is supposed to look at an access
table, pull out each bid record, link to another table to find all of
the people to send the email to and link to one more table to find who
should be cc'd on the note.

All of this works fine, except.... The arrays for the To and CC seem
to exclude names from the list if there are multiple recipients and I
can't pinpoint what I have done incorrectly. I am fairly new to arrays
and have never sent an email through Lotus Notes until this script so
please forgive some of my coding.

Here is the code I am using and I greatly appreciate any help.

Thanks in advance,

Nicole

Dim myDb As DAO.Database
Dim rs As DAO.Recordset
Dim rsTo As DAO.Recordset
Dim rsCC As DAO.Recordset
Dim project As String
Dim closedate As String
Dim messagesubject As String
Dim Copy As String
Dim sNames() As String
Dim ccNames() As String
Dim OnviaLink As String


' opens database and finds available records from query
Set myDb = CurrentDb
Set rs = myDb.OpenRecordset("select * from
OnviaDataConcatenatedEmailFields")

lngRSCount = rs.RecordCount
If lngRSCount = 0 Then
MsgBox "No bid alerts to send.", vbInformation
Else
rs.MoveLast
lngRSCount = rs.RecordCount
rs.MoveFirst
Do Until rs.EOF


'determines the product family and determines information for subject
and body
If rs!ProductFamily = "Truck" Then
project = rs!ProjectName
Else
project = rs!ProductFamily
End If

'determines if an a is necessary for grammar in the message body
If Right(project, 1) = "s" Then
plural = ""
Else
plural = "a "
End If

'creates message subject
messagesubject = "Bid Alert/ " & rs!ProjectCity & "/ " & project

'finds if a close date is provided or not
If rs!SubmitDate <> "" Then
closedate = rs!SubmitDate
Else
closedate = "not available"
End If

' Opening Line
strbody = "Included below is a bid requst for " & rs!Agency & ", " &
rs!State & " for " & plural & project & ". " & _
"Close date is " & closedate & ". " & _
"Please see below for more detail and let me know if this alert has
helped" & _
vbCrLf & vbCrLf & _
"Regards," & _
vbCrLf & vbCrLf & _
"Nicole Mauser-Storer" & vbCrLf & "NACD Governmental Sales" & vbCrLf
& "(309)-494-1109" & vbCrLf & "Mauser_Storer_Nicole_L@cat.com" & vbCrLf
& vbCrLf



'Bid Information

strbody = strbody & "General Information" & vbCrLf & vbCrLf

strbody = strbody & "Project Name: " & rs!ProjectName & vbCrLf
strbody = strbody & "Bid #: " & rs!BidNo & vbCrLf
strbody = strbody & "Agency: " & rs!Agency & vbCrLf
strbody = strbody & "Close Date: " & closedate & vbCrLf
strbody = strbody & "Contact Name: " & rs!contactName & vbCrLf
strbody = strbody & "Contact Phone: " & rs!Phone & vbCrLf
strbody = strbody & "Email: " & rs!Email & vbCrLf
strbody = strbody & "City: " & rs!ProjectCity & vbCrLf
strbody = strbody & "Zip: " & rs!Zip & vbCrLf
strbody = strbody & "Sector: " & rs!Sector & vbCrLf
strbody = strbody & "URL: " & rs!URL & vbCrLf
strbody = strbody & "Description: " & rs!Description

OnviaLink = rs!OnviaNo


'Declare To Array for Email message

strSQL = "SELECT ToCurrentBids.ToEmail,
OnviaDataConcatenatedEmailFields.OnviaNo " & _
"FROM ToCurrentBids INNER JOIN
OnviaDataConcatenatedEmailFields ON " & _
"ToCurrentBids.OnviaNo =
OnviaDataConcatenatedEmailFields.OnviaNo WHERE ToCurrentBids.OnviaNo =
'" & OnviaLink & "';"

Set rsTo = myDb.OpenRecordset(strSQL)

lngRScount2 = rsTo.RecordCount
If lngRScount2 = 0 Then
MsgBox "No addresses in To Field.", vbInformation
Else
rsTo.MoveLast
lngRScount2 = rsTo.RecordCount
rsTo.MoveFirst
Do Until rsTo.EOF

ReDim Preserve sNames(1 To lngRScount2)
sNames(UBound(sNames)) = rsTo!TOEmail


rsTo.MoveNext
Loop



End If
rsTo.Close
Set rsTo = Nothing
Set strSQL = Nothing

'Declare CC Array for message

strSQL = "SELECT CCCurrentBids.CCEmail,
OnviaDataConcatenatedEmailFields.OnviaNo " & _
"FROM CCCurrentBids INNER JOIN
OnviaDataConcatenatedEmailFields ON " & _
"CCCurrentBids.OnviaNo =
OnviaDataConcatenatedEmailFields.OnviaNo WHERE CCCurrentBids.OnviaNo =
'" & OnviaLink & "';"



Set rsCC = myDb.OpenRecordset(strSQL)

lngRScount3 = rsCC.RecordCount
If lngRScount3 = 0 Then
MsgBox "No addresses in CC Field.", vbInformation
Else
rsCC.MoveLast
lngRScount3 = rsCC.RecordCount
rsCC.MoveFirst
Do Until rsCC.EOF

ReDim Preserve ccNames(1 To lngRScount3)
ccNames(UBound(ccNames)) = rsCC!CCEmail


rsCC.MoveNext
Loop

End If
rsCC.Close
Set rsCC = Nothing
Set strSQL = Nothing


'Public Sub SendNotesMail(Subject as string, attachment as string,
'recipient as string, bodytext as string,saveit as Boolean)
'This public sub will send a mail and attachment if neccessary to the
'recipient including the body text.
'Requires that notes client is installed on the system.

'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")
'Next line only works with 5.x and above. Replace password with
your password
'Session.Initialize ("9707KB")
'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 or using above password you can use other
mailboxes.
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
MailDoc.Form = "Memo"
MailDoc.sendto = sNames
MailDoc.CopyTo = ccNames
MailDoc.Subject = messagesubject
MailDoc.Body = strbody
MailDoc.SAVEMESSAGEONSEND = SaveIt


'Send the document
MailDoc.PostedDate = Now() 'Gets the mail to appear in the sent
items folder
MailDoc.SEND 0, Recipient
Call MailDoc.Save(True, False)

'Clean Up
Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set Session = Nothing
Set EmbedObj = Nothing
Set lngRSCount = Nothing
Set lngRScount2 = Nothing
Set lngRScount3 = Nothing



Erase sNames
Erase ccNames

rs.MoveNext
Loop
End If
rs.Close
myDb.Close
Set rs = Nothing
Set myDb = Nothing
Close

re: VBA Array to Lotus Notes email Looping Problem

It does not appear you are using the Notes Domino object model for
passing your email. Using the Domino Library you can use this code in
an Access module. The Domino object model will read an array
internally, you don't have to do any looping, just pass the array

Sub SendNotesMail(p_SendTo() As String, p_Subject As String, p_Body As
String, p_Path() As String, p_NotesPassword As String)
Dim n_Session As New NotesSession
Dim n_dir As NotesDbDirectory
Dim n_db As NotesDatabase
Dim n_doc As NotesDocument
Dim n_object As NotesEmbeddedObject
Dim n_rtitem As NotesRichTextItem
Dim i As Integer
Call n_Session.Initialize(p_NotesPassword)

Set n_dir = n_Session.GetDbDirectory("")
Set n_db = n_dir.OpenMailDatabase
Set n_doc = n_db.CreateDocument
Call n_doc.AppendItemValue("Form", "Memo")

Call n_doc.AppendItemValue("SendTo", p_SendTo())
Call n_doc.AppendItemValue("Subject", p_Subject)

Set n_rtitem = n_doc.CreateRichTextItem("Body")
n_rtitem.AppendText (p_Body & vbCrLf & vbCrLf)
For i = 0 To UBound(p_Path)
Set n_object = n_rtitem.EmbedObject(EMBED_ATTACHMENT, "", p_Path(i))
Next i
n_doc.SaveMessageOnSend = True
Call n_doc.Send(False)

Set n_db = Nothing
Set n_Session = Nothing
MsgBox "Email has been sent"
End Sub


the array p_SendTo() can take any email name or group name. Just pass
it to the routine. This routine also does attachments.


Rich

*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!