Email from Access form using Groupwise

[KerryL]

Help!

I'm using a cmdSend button to automatically email messages to multiple recipients. The code is supposed to send emails (from an MS Access form) to each of the people listed in a set of records, but only the person/email-address in the first record is receiving the email. I use a DoWhile loop until EOF is reached to make it happen, so it looks as though it's not looping back through, or possibly the code thinks the EOF has been reached after dealing with the first record.

I can't figure out why only the first recipient is receiving the email and I'm wondering if maybe a second set of eyes might see something obvious I'm overlooking.

Any help or advice would be greatly appreciated. Here's the private subroutine code from the cmdSend button:

Private Sub cmdSend_Click()
    ' Comments  : Send e-mail from Contact to card holders listed in document
    '             Message sent depends on FYI/RFI field
    '             Supervisors are bcc'd on RFI findings
    ' Parameters:
    ' Created   : 10/12/2000 12:19 PM TRC
    ' Modified  : 09/24/2001 KBL  Split enter & review findings into two forms with separate code
    '
    ' --------------------------------------------------
    
'    On Error GoTo PROC_ERR
    
    Dim dbs As Database
    Dim qryEmail As QueryDef
    Dim rstEmail As DAO.Recordset
    Dim GenlInfo As GenlInfo
    Dim strTo As String
    Dim strCC As String
    Dim strMsg As String
    Dim intHeaderID As Integer
    GenlInfo = ggiGenlInfo

    'Send email notifications to CardHolders
    Set dbs = CurrentDb
    Set qryEmail = dbs.QueryDefs("qryEmailInfo")
    qryEmail.Parameters("pHeaderID") = CLng(txtHeaderID)
    Set rstEmail = qryEmail.OpenRecordset
 
With rstEmail
    If .RecordCount > 0 Then
        Do While Not .EOF
        ' Check for missing data
        '   Email address
        If Nz(.Fields("StaffEmail")) = "" Then
            MsgBox "Card holder, " & .Fields("StaffFName") & " " & .Fields("StaffLName") & _
                    ", does not have an email address" & vbCrLf & _
                    "Check listing against sent items folder", _
                vbInformation + vbOKOnly, _
                "Missing Email"
        Else
            strTo = .Fields("StaffEmail")

            '   Supervisor address
            If Nz(.Fields("SpvsrEmail")) = "" Then
                strCC = GenlInfo.ContactEmail
            Else
                strCC = .Fields("SpvsrEmail")
            End If
           
                ' Generate message text
            strMsg = vbCrLf & vbCrLf & _
                Format(Nz(rstEmail("Amount"), 0), "\$###,##0.00") & vbCrLf & _
                .Fields("Findings") & vbCrLf & vbCrLf & _
                GenlInfo.Contact
            
            Select Case .Fields("FYI_RFI")
                    'Send message
                Case True  'bcc to supvr and OCG supvr for FYI
                    strMsg = GenlInfo.FYIText & strMsg
                    DoCmd.SendObject acSendNoObject, , acFormatRTF, _
                        To:=strTo, _
                        Bcc:=strCC & ";" & GenlInfo.OCGEmail, _
                        Subject:="Procurement Card Findings", _
                        MessageText:=strMsg, _
                        EditMessage:=False

                Case Else  'cc to supvr for RFI, bcc to OCG supvr
                    strMsg = GenlInfo.RFIText & strMsg
                    DoCmd.SendObject acSendNoObject, , acFormatRTF, _
                        To:=strTo, _
                        Cc:=strCC, _
                        Bcc:=GenlInfo.OCGEmail, _
                        Subject:="Procurement Card Findings", _
                        MessageText:=strMsg, _
                        EditMessage:=False
            End Select
            
            'Update date fields
            .Edit
                .Fields("EmailToCardHoldersDate") = Date
            .Update
        End If  'missing email address
        .MoveNext
        Loop
        MsgBox "Emails sent to cardholders", , "Email Sent"
    Else
        MsgBox "There were no staff details for this document that have not been sent.", vbOKOnly + vbInformation, _
            "No Data"
    End If  'detail records exist
End With

PROC_EXIT:
    Exit Sub
    
PROC_ERR:
    If Err.Number = 2501 Then   'user cancelled sendobject
        Resume Next
    End If
    MsgBox Err.Number & ": " & Err.Description & vbCrLf & "in Module: Form_frmDocument, Proc: cmdSend_Click"
    Resume PROC_EXIT
    
End Sub

[\CODE]


Thanks in advance,
Kerry

 

[DougP]

I would remove this "IF" statement
If .RecordCount > 0 Then
and the corresponding "End if"

I appaers as though you are checking the existance of records twice
Once with the "IF" , "End If" and also in the "DO LOOP".

If there are no records it will fall through the "DO LOOP" anyway thus negating the need for the IF statement before it.

Also I would temporarliy eleimate all of th echecking a constraints you have put in. See it will e-mail two or more people.
When it does then add the constraints back one aat a time.

Also use the Debug feature and examine the values of your variables as the code is running
Open the code window then press F9 key on this line
Set dbs = CurrentDb
it should turn red
Run your code an d it will stop on the RED line
Next press F8 to step one line at a time.
Then hold the mouse pointer over a variable to view its contents.

OK
DougP, MCP

Visit my WEB site

http://www.barcodeone.com

to see how Bar-codes can help you be more productive