Send Email

[cbrsix]

I have a form that has 5 listboxes that allow someone to search for the specified criteria. The results are then shown in a subform. My problem is not with the search feature but rather the sending the email part of the code that I have. Below is all of the code attached to the form. I am unable to get the clients name and email to populate because when I search, the query removes that criteria that I need to send the email to the appropriate person. Here is my code and a snapshot of the query criteria.

 
Private Sub ClearEmail_Click()
'clear email textboxes
Me.EmailBody = "Enter Body..."
Me.EmailSubject = "Enter Subject..."
Me.EmailSubject.SetFocus
End Sub
Private Sub ClearSelections_Click()
'clear all selections
Me.CompanyNameList = ""
Me.RepList = ""
Me.ProductTypeList = ""
Me.AccountTypeList = ""
Me.BusinessTypeList = ""
'Update the record source
Me.SearchEmailSubform.Form.RecordSource = "Select * From SearchEmail " & BuildFilter
'Requery the subform
Me.Form!SearchEmailSubform.Form.Requery
End Sub
Private Sub CloseForm_Click()
'clears the entire form
ClearEmail_Click
ClearSelections_Click
'close form
DoCmd.Close acForm, "EmailToClients"
End Sub
 
Private Sub FilterSelections_Click()
'Update the record source
Me.SearchEmailSubform.Form.RecordSource = "Select * From SearchEmail " & BuildFilter
'Requery the subform
Me.Form!SearchEmailSubform.Form.Requery
End Sub
Private Sub Form_Load()
'clears the entire form
ClearEmail_Click
ClearSelections_Click
'Update the record source
Me.SearchEmailSubform.Form.RecordSource = "Select * From SearchEmail " & BuildFilter
'Requery the subform
Me.Form!SearchEmailSubform.Form.Requery
End Sub
Private Sub SendEmail_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
    
    strSQL = "SearchEmail" '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 = "xxxx@example.com" 'This is where I want the clients email address to go
        Set myOlApp = CreateObject("Outlook.Application")
        Set myItem = myOlApp.CreateItem(olMailItem)
        Set myAttachments = myItem.Attachments
        Set myRecipient = myItem.Recipients.Add(recipient)
        myItem.BCC = "xxxx@example.com;" '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 = "ClientName" & "," & Chr(13) & Chr(10) & Chr(13) & Chr(10) & Me.EmailBody & Chr(13) & Chr(10) & Chr(13) & Chr(10) & "Thanks."
        myItem.Display
        rst.MoveNext
    Wend
    DoCmd.Close acForm, "EmailToClients" '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
SendEmail_Exit:
    Exit Sub
SendEmail_Err:
    MsgBox Err.Description
    Resume SendEmail_Exit
End Sub
Private Function BuildFilter() As Variant
Dim varWhere As Variant
BuildFilter = varWhere
Dim db As Dao.Database
   Dim qdf As Dao.QueryDef
   Dim varItem As Variant
   Dim strCriteria As String
   Dim strCriteria1 As String
   Dim strCriteria2 As String
   Dim strCriteria3 As String
   Dim strCriteria4 As String
   Dim strCriteria5 As String
   Dim strSQL As String
   Set db = CurrentDb()
   Set qdf = db.QueryDefs("SearchEmail")
   If Me!BusinessTypeList.ItemsSelected.Count > 0 Then
      For Each varItem In Me!BusinessTypeList.ItemsSelected
         strCriteria = strCriteria & "[Account List].BusinessType = " & Me!BusinessTypeList.ItemData(varItem) & "OR "
      Next varItem
      strCriteria = Left(strCriteria, Len(strCriteria) - 3)
    Else
      strCriteria = "[Account List].BusinessType Like '*'"
   End If
   If Me!AccountTypeList.ItemsSelected.Count > 0 Then
      For Each varItem In Me!AccountTypeList.ItemsSelected
         strCriteria1 = strCriteria1 & "[Account List].AccountType = " & Me!AccountTypeList.ItemData(varItem) & "Or "
      Next varItem
      strCriteria1 = Left(strCriteria1, Len(strCriteria1) - 3)
    Else
      strCriteria1 = "[Account List].AccountType Like '*'"
   End If
   If Me!ProductTypeList.ItemsSelected.Count > 0 Then
      For Each varItem In Me!ProductTypeList.ItemsSelected
         strCriteria2 = strCriteria2 & "[Account List].ProductType = " & Me!ProductTypeList.ItemData(varItem) & "Or "
      Next varItem
      strCriteria2 = Left(strCriteria2, Len(strCriteria2) - 3)
    Else
      strCriteria2 = "[Account List].ProductType Like '*'"
   End If
   If Me!RepList.ItemsSelected.Count > 0 Then
      For Each varItem In Me!RepList.ItemsSelected
         strCriteria3 = strCriteria3 & "[Account List].Rep = " & Chr(34) & Me!RepList.ItemData(varItem) & Chr(34) & "Or "
      Next varItem
      strCriteria3 = Left(strCriteria3, Len(strCriteria3) - 3)
    Else
      strCriteria3 = "[Account List].Rep Like '*'"
   End If
   If Me!CompanyNameList.ItemsSelected.Count > 0 Then
      For Each varItem In Me!CompanyNameList.ItemsSelected
         strCriteria4 = strCriteria4 & "[Account List].CompanyName = " & Me!CompanyNameList.ItemData(varItem) & "Or "
      Next varItem
      strCriteria4 = Left(strCriteria4, Len(strCriteria4) - 3)
    Else
      strCriteria4 = "[Account List].CompanyName Like '*'"
   End If
   strCriteria5 = "[Account List].Status = 'Active'"
   strSQL = "SELECT * FROM [Account List] " & "WHERE " & "(" & strCriteria & ") AND (" & strCriteria1 & ") AND (" & strCriteria2 & ") AND (" & strCriteria3 & ") AND (" & strCriteria4 & ") AND (" & strCriteria5 & ")" & "; "
   qdf.SQL = strSQL
   Set db = Nothing
   Set qdf = Nothing
End Function

How can I get the client name and email to be apart of the email?