Send email with concat emails using sendobject from query with filters (parameters) (1 Viewer)

[RPettinger]

Hi all,

I have a subform based on a query with five combo boxes in the main form to filter the subform. This works fine.


What I want to do is filter this subform, hit an "email" button and use SendObject to pull the emails from the filtered subform and open outlook with a new email with the filtered emails in.

The code I have, which works for unfiltered queries, is below. The question I am having problems working out is: Where to add the code for the filters (parameters)? and what is the code?

When I run the bellow code I get the error message "Error No: 3061 Two few parameters. Expected 5." the expected parameters are below.

Help would be greatly appreciated!

frmName: frmManageImplementerDetails
Subfrm: subfrmImplementerList
qry: qryImplementerListAll

Filter1: cmbFilterType
Filter2: cmbFilterNationality
Filter3: cmbFilterExpertise
Fitler4: cmbFilterPortfolio
Filter5: cmbFilterRAG

Private Function ImpList() As String
'-- Return all of the email addresses in the EmailAddress table
'-- as one string separated with a semicolon ";"

On Error GoTo Err_ImpList

Dim MyRs As DAO.Recordset
Set MyRs = CurrentDb().OpenRecordset("qryImplementerListAll", dbOpenForwardOnly)

'-- Filter the table for parameters

Me.Filter = ""

With MyRs
   Do While Not .EOF
      ImpList = ImpList & ![ContactEmail] & ";"
      .MoveNext
   Loop
End With

'-- Strip off the last ";"
PMList = Left(ImpList, Len(ImpList) - 1)

Exit_ImpList:
If Not MyRs Is Nothing Then
    MyRs.Close
    Set MyRs = Nothing
End If
Exit Function
    
Err_ImpList:
   MsgBox "Error No:    " & Err.Number & vbCr & _
   "Description: " & Err.Description
   Resume Exit_ImpList

End Function

Private Sub EmailImp_Click()
On Error GoTo ErrorHandler

Dim ToList As String

DoCmd.RunCommand acCmdSaveRecord
ToList = ImpList()

DoCmd.SendObject acSendNoObject, , , ToList, , , _
Format$(Date, "ddmmyy") & "_Prosperity Update", "Dear All", True, """"

Cleanup:
  Exit Sub

ErrorHandler:
  Select Case Err.Number
    Case 2501
      MsgBox "Message not sent"
      Case 2498
      MsgBox "No email address found for contact, please update information"
    Case Else
      MsgBox Err.Number & ": " & Err.Description
      
  End Select
  Resume Cleanup
End Sub

 

[GinaWhipp]

You can't use the query like that for export, you have to create it on the fly, some like...

AIR CODE

Dim dbs As DAO.Database
        Dim qryDef As DAO.QueryDef
        Dim strSQL As String
        Dim strWhere As String
        Dim lngLen As Long
        Set dbs = CurrentDb
    
    strSQL = "SELECT...  (Your SELECT statement goes here)"
 
    If Not IsNull(Me.cmbFilterType) Then
        strWhere = strWhere & "([MatchingFieldInYouQuery] = """ & Me.cmbFilterType & """) AND "
    End If
    
    If Not IsNull(Me.cmbFilterNationality) Then
        strWhere = strWhere & "([MatchingFieldInYouQuery] = """ & Me.cmbFilterNationality & """) AND "
    End If
    
'Add balance of th fields to filter on...
   
    lngLen = Len(strWhere) - 5
    
    If lngLen <= 0 Then
        strSQL = strSQL
        Set qryDef = dbs.CreateQueryDef("qryImplementerList", strSQL)
       'Send your eMail here...
        DoCmd.DeleteObject acQuery, "qryImplementerList"
    Else
        strWhere = Left$(strWhere, lngLen)
        strSQL = strSQL & " WHERE " & strWhere
        Set qryDef = dbs.CreateQueryDef("qryImplementerList", strSQL)
        'Send your eMail here...
        DoCmd.DeleteObject acQuery, "qryImplementerList"
    End If
    
        dbs.Close
        Set dbs = Nothing