Access Send Email Issue

[DJRhino1175]

Here is the code As a whole...

Private Sub cmdEmail_Click()

  On Error GoTo EH
  
    Dim strSendTo     As String
    Dim strSubject    As String
    Dim strEMailBody  As String
    Dim MyDB As DAO.Database
    Dim rstEMail As DAO.Recordset
    
    Set MyDB = CurrentDb
    Set rstEMail = MyDB.OpenRecordset("Select * From tblEMail", _
    dbOpenSnapshot, dbOpenForwardOnly)
    
   With rstEMail
            If Not (.BOF And .EOF) Then
                Call .MoveFirst
                Do While Not .EOF
                    'Build the Recipients String
                    strSendTo = ""
                    strSendTo = _
                        strSendTo & _
                        IIf(strSendTo = "", _
                            "", _
                            ";") & _
                        !Email
                    Call .MoveNext
                Loop
            End If
            Call .Close
        End With

        Call MyDB.Close
        Set rstEMail = Nothing
        Set MyDB = Nothing
    
    strSubject = "New Part Number Tasks"
    strEMailBody = "Please check for tasks you need to perform"
    
    'Generate and Display the E-Mail
    Call SendAnEmail(olSendTo:=strSendTo, _
                     olSubject:=strSubject, _
                     olEMailBody:=strEMailBody, _
                     olDisplay:=True, _
                     SendAsHTML:=True)
 
    Exit Sub
EH:
    MsgBox "There was an error sending mail!" & vbCrLf & vbCrLf & _
        "Error: " & Err.Number & vbCrLf & _
        "Description: " & Err.Description & vbCrLf & vbCrLf & _
        "Please contact your Database Administrator.", vbCritical, "WARNING!"
    Exit Sub

End Sub

The area that seems to not work is thes one:

   Set MyDB = CurrentDb
    Set rstEMail = MyDB.OpenRecordset("Select * From tblEMail", _
    dbOpenSnapshot, dbOpenForwardOnly)
    
   With rstEMail
            If Not (.BOF And .EOF) Then
                Call .MoveFirst
                Do While Not .EOF
                    'Build the Recipients String
                    strSendTo = ""
                    strSendTo = _
                        strSendTo & _
                        IIf(strSendTo = "", _
                            "", _
                            ";") & _
                        !Email
                    Call .MoveNext
                Loop
            End If
            Call .Close
        End With

        Call MyDB.Close
        Set rstEMail = Nothing
        Set MyDB = Nothing

It will display the email but with only one address in the To: area. It should have multiple as I have 5 entries in my table.

So my guess is that I have something typed incorrectly that I cannot see. Can someone please look it over and tell me where I went wrong.

Thanks,

Rhino

[ADezii]

A couple of minor adjustments should do the trick:

Dim MyDB As DAO.Database
Dim rstEMail As DAO.Recordset
Dim strSendTo As String

Set MyDB = CurrentDb
Set rstEMail = MyDB.OpenRecordset("Select * From tblEMail", _
                    dbOpenSnapshot, dbOpenForwardOnly)
 
With rstEMail
  If Not (.BOF And .EOF) Then
    Do While Not .EOF
      If Not IsNull(![Email]) Then
        strSendTo = strSendTo & !Email & ";"
      End If
        .MoveNext
    Loop
  End If
End With

'Remove Trailing Semi Colon (';')
strSendTo = Left$(strSendTo, Len(strSendTo) - 1)

'Verify String
MsgBox strSendTo

rstEMail.Close
Set rstEMail = Nothing
MyDB.Close
Set MyDB = Nothing

[DJRhino1175]

Worked perfectly, apparently I had to much in the code

Thanks a million ADezii

[ADezii]

You are quite welcome.