469,957 Members | 2,628 Online
Bytes | Developer Community
New Post

Home Posts Topics Members FAQ

Post your question to a community of 469,957 developers. It's quick & easy.

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,


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

lngRSCount = rs.RecordCount
If lngRSCount = 0 Then
MsgBox "No bid alerts to send.", vbInformation
lngRSCount = rs.RecordCount
Do Until rs.EOF
'determines the product family and determines information for subject
and body
If rs!ProductFamily = "Truck" Then
project = rs!ProjectName
project = rs!ProductFamily
End If

'determines if an a is necessary for grammar in the message body
If Right(project, 1) = "s" Then
plural = ""
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
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 & "Ma********************@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 " & _
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
lngRScount2 = rsTo.RecordCount
Do Until rsTo.EOF

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

End If
Set rsTo = Nothing
Set strSQL = Nothing

'Declare CC Array for message

strSQL = "SELECT CCCurrentBids.CCEmail,
OnviaDataConcatenatedEmailFields.OnviaNo " & _
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
lngRScount3 = rsCC.RecordCount
Do Until rsCC.EOF

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

End If
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
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
'can pass an empty string or using above password you can use other
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
End If

'Set up the new mail document
MailDoc.Form = "Memo"
MailDoc.sendto = sNames
MailDoc.CopyTo = ccNames
MailDoc.Subject = messagesubject
MailDoc.Body = strbody
'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

End If
Set rs = Nothing
Set myDb = Nothing

Nov 13 '05 #1
1 4293
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.

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

This discussion thread is closed

Replies have been disabled for this discussion.

Similar topics

5 posts views Thread by NickBlooruk | last post: by
2 posts views Thread by DeanL | last post: by
3 posts views Thread by =?Utf-8?B?SmFtZXNU?= | last post: by
reply views Thread by rainxy | last post: by
By using this site, you agree to our Privacy Policy and Terms of Use.