Send Email

[cbrsix]

I have some code to send an email to a query in my database. I want to get the recipients in a string and have it send out in one email. Currently what is happening is that when I press send, it opens a new email with each additional email in the string. The last email to open has all the emails in one string ready to send. How do I get it so it doesn't open an email for each other email selected. For example, there are 3 emails to send, the emails that open up in outlook look as follows...
Email 1: 1@example.com
Email 2: 1@example.com; 2@example.com
Email 3: 1@exampl.com; 2@example.com; 3@example.com



How do I get only the 3rd and final email to come up?

Here is my code.

Private Sub CmdEmail_Click()
On Error GoTo SendEmail_Err
    Dim myOlApp As Object
    Dim myNameSpace As Object
    Dim myFolder As Object
    Dim myItem As Object
    Dim myAttachments, myRecipient As Object
    Dim recipient As String
    Dim file_name As String
    Dim mySubject As Object
    Dim dbs As Object
    Dim rst As Object
    Dim strSQL As String
    Dim SentOnBehalfOfName As String
    Dim recipient1 As String
    
If Me.CountEmail > 0 Then
    strSQL = "SendStudentEmail" 'Select the Query where you want your information to be drawn from
    Set dbs = CurrentDb
    Set rst = dbs.OpenRecordset(strSQL)
    rst.MoveFirst
    While Not rst.EOF
        recipient = recipient & rst!StudentEmail & ";" 'This is the email address that you corresponds to your recipient
        Set myOlApp = CreateObject("Outlook.Application")
        Set myItem = myOlApp.CreateItem(olMailItem)
        Set myAttachments = myItem.Attachments
        Set myRecipient = myItem.Recipients.Add(recipient)
        myItem.SentOnBehalfOfName = "SENDER EMAIL"
        'myItem.BCC = "" 'Enter any other email recipient that you want CC'd for this email
        '"Message Subject String Here"
        myItem.Subject = Me.EmailSubject
        '"Put Message Body Text Here"
        myItem.Body = "Dear Former Student" & "," & Chr(13) & Chr(10) & Chr(13) & Chr(10) & Me.EmailBody
        myItem.Display
        rst.MoveNext
    Wend
    'DoCmd.Close acForm, "SendEmail" 'Closes the form
    'DoCmd.OpenForm "EmailConfirmation" 'Opens Email Confirmation Form
    Set myRecipient = Nothing
    Set myAttachments = Nothing
    Set myItem = Nothing
    Set myOlApp = Nothing
    Set rst = Nothing
 Else
    response = MsgBox("There are no recipients to send to.", vbOKOnly)
End If
SendEmail_Exit:
    Exit Sub
SendEmail_Err:
    MsgBox Err.Description
    Resume SendEmail_Exit
End Sub

[June7]

The only thing that needs to be within the While loop is the Recipients string construct. The Set lines and Me.Display must be outside the loop.

I think you are double adding the recipients by concatenating the recipients variable and with the Add method. Remove line:

recipient = recipient & rst!StudentEmail & ";"

and try

Set myRecipient = myItem.Recipients.Add(rst!StudentEmail)