Sending group email.

[psamu]

I have following code, It works, but only problem I have is when Fields (1) or Fields (3) is empty ( means no email address) then it throws error.
In ON CLICK event
Dim PassWord As String
PassWord = InputBox("Enter Password")
If PassWord = "Hello" Then
' Open Form



'...
Dim MyDb As DAO.Database
Dim rsEmail As DAO.Recordset
Dim sToName As String
Dim sCcName As String
Dim sSubject As String
Dim sMessageBody As String

Set MyDb = CurrentDb()
Set rsEmail = MyDb.OpenRecordset("Followup Email", dbOpenSnapshot)

With rsEmail
.MoveFirst
Do Until rsEmail.EOF
If IsNull(.Fields(0)) = False Then
sToName = .Fields(0) & ";" & .Fields(1)
sCcName = .Fields(2) & ";" & .Fields(3)
sSubject = "Reminder #: " & .Fields(4)
sMessageBody = "Reminder: Please check this item assigned to you showing as Overdue " & vbCrLf & _
"Received From: " & .Fields(5) & ", Due Date: " & .Fields(10) & ", " & .Fields(9) & vbCrLf & _
"Message: " & .Fields(7)

DoCmd.SendObject acSendNoObject, , , _
sToName, sCcName, , sSubject, sMessageBody, False, False
End If
.MoveNext
Loop
End With

Set MyDb = Nothing
Set rsEmail = Nothing
Else
MsgBox ("You're not authorized")
End If
End Sub

 

[Micron]

So what do you want to have happen when this condition exists? If it is to email anyway, then I suggest wrapping an IF block around each recipient field:

If IsNull(rs.fields(1)) or rs.fields(1)="" then
   sToName = rs.Fields(0) 
Else
   sToName = rs.Fields(0) & ";" & rs.Fields(1)
End If

If IsNull(rs.Fields(3)) or rs.Fields(3)="" then
  sCcName = rs.Fields(2)
Else
  sCcName = .Fields(2) & ";" & .Fields(3)
End if

Your issue might be the trailing semicolon you'd get if there are no second names. If not, you should always state on what line the error occurs and what the message number and text is. Also, you should use code tags around your code. It enables you to add leading spaces as you probably would in your code module and makes it easier for us to read.

I don't actually test for null and empty string this way anymore. I have a UDF that returns true if either condition exists and I test for it by passing the value I want to check:

If noData(rs.fields(1)) Then...

 

[psamu]

Thank you. Still I am getting error Run-time error '3021':
No current record.

Error pointing to .MoveFirst


With rsEmail
.MoveFirst
Do Until rsEmail.EOF
If IsNull(rs.Fields(1)) Or rs.Field(1) = "" Then
sToName = rs.Fields(0)
Else
sToName = rs.Fields(0) & ";" & rs.Fields(1)
End If
If IsNull(rs.Fields(3)) Or rs.Fields(3) = "" Then
sCcName = rs.Fields(2)
Else
sCcName = .Fields(2) & ";" & .Fields(3)
End If

sSubject = "Reminder #: " & .Fields(4)
sMessageBody = "Reminder: Please check this item assigned to you showing as Overdue " & vbCrLf & _
"Received From: " & .Fields(5) & ", Due Date: " & .Fields(10) & ", " & .Fields(9) & vbCrLf & _
"Message: " & .Fields(7)

DoCmd.SendObject acSendNoObject, , , _
sToName, sCcName, , sSubject, sMessageBody, False, False
'End If
.MoveNext
Loop
End With

 

[psamu]

Thank you. Now the error is Run-time error '3021': No current record.

It is pointing to . MoveFirst

 

[Micron]

Whoops. Sorry, I neglected to reference the proper recordset variable name. I should have put rsEmail, not just rs. I'm wondering if you ever had this working, because I don't think the email body code (html) works with vbCrLf. I think you have to use the html versions (<P> for example).

Also, you are not reclaimng memory reserved for your object by destroying it at the end of your procedure:
Set rsEmail=Nothing
Set myDb = Nothing
Do you know about error handling routines, because I don't see one here.

>

 

[psamu]

Thanks. It was working before if I have both email address available. Now throwing error even both email available . I changed to rsEmail. Set MyDb = Nothing and Set rsEmail = Nothing. Already there

 

[Micron]

You are not specific enough for me to help much. "both email address"? What, both - 'To' names? Both CC names?
It is not enough to say you changed code but are still getting an error. What error - same one? Same place?
If same error, maybe the query you use is not returning any records. Put this before the email code:

rsEmail.MoveLast
msgbox rsEmail.RecordCount

If the message box retruns zero (0) then there are no records, thus you cannot move first. It's good practice to exit your code at the beginning if there are no records to work with, otherwise you will get such errors unless you handle them in an error handling routine.

 

[psamu]

Sorry I did not mention both email I mean To: Two emails and CC: Two emails. My query returns correct. Now if I have both ( TO: test@kk.com;test2@kk.com) and (CC:test3@kk.com;test4@kk.com) it will work. but when I have email ( TO: test@kk.com) and (CC:test3@kk.com) does not work. Thank you.

 

[Micron]

does not work

Again, this means nothing to me - you have to assume I know nothing about what you see, because I don't. Does this mean there is still a 3021 error or what? If so, you probably need to ignore the rest, and I am just wasting time.

If not and you are saying it is sending email if you have TO:test@kk.com;test2@kk.com AND you have CC:test3@kk.com;test4@kk.com, what about
TO:test@kk.com;test2@kk.com but NO CC addresses? If it works in this situation, I'm wondering if you have extra spaces or characters at the end when you have one address. If you use Outlook directly, extra spaces after the last TO recipient are not a problem. Perhaps it is when doing it via code. To see what you have after only one recipient, make sure your query returns records with only one recipient and try this:

After this line "Message: " & .Fields(7) put debug.print "TO part:" & sToName & ": CC part: & sCcName & ":"
Then put a break on this line DoCmd.SendObject and make sure you have the immediate window visible in your VB editor. Then run your sub and look in the immediate window.
See if there are any spaces, semicolons or any other characters between the colons and the recipient addresses
(e.g. looking for TO part:test2@kk.com: not TO part:test2@kk.com : .

Remember to remove or comment out the debug line when it's not needed anymore.

 

[psamu]

Thank you for your help. It worked out. It was my mistake. I commented out the "End if" below before.
With rsEmail
.MoveFirst
Do Until rsEmail.EOF
If IsNull(rs.Fields(1)) Or rs.Field(1) = "" Then
sToName = rs.Fields(0)
Else
sToName = rs.Fields(0) & ";" & rs.Fields(1)
End If
If IsNull(rs.Fields(3)) Or rs.Fields(3) = "" Then
sCcName = rs.Fields(2)
Else
sCcName = .Fields(2) & ";" & .Fields(3)
End If

sSubject = "Reminder #: " & .Fields(4)
sMessageBody = "Reminder: Please check this item assigned to you showing as Overdue " & vbCrLf & _
"Received From: " & .Fields(5) & ", Due Date: " & .Fields(10) & ", " & .Fields(9) & vbCrLf & _
"Message: " & .Fields(7)

DoCmd.SendObject acSendNoObject, , , _
sToName, sCcName, , sSubject, sMessageBody, False, False
'End If
.MoveNext
Loop
End With