I want to create an if statement in a public sub to open a specific query based on button click-CodePudding

I am wanting to consolidate my VBA so it is easier to manage and see rather than duplicating it several times. I would like to then write an if statement inside of the sub that opens the recordset based on the button I click There are 4 buttons cmdAllSuppliers cmdActive cmdInactive cmdArrangments Each button has the VBA that calls the sub EmailQuery and error handling. the sub code is as follows.

Sub EmailQuery()

    Dim cn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim strEmail As String
    Dim strQryAll As String
    Dim strQryActive As String
    Dim strQryInactive As String
    Dim strQryArrangement As String

    Set cn = CurrentProject.Connection
    Set rs = New ADODB.Recordset

    strQryAll = "qryAllSuppliers"
    strQryActive = "qryActiveSuppliers"
    strQryInactive = "qryInactiveSuppliers"
    strQryArrangement = "qryAgreementEmail"

    rs.Open strQryAll, cn
    rs.Open strQryActive, cn
    rs.Open strQryInactive, cn
    rs.Open strQryArrangement, cn

    With rs
        Do While Not .EOF
            strEmail = strEmail & .Fields("Email") & ";"
            .MoveNext
        Loop
        .Close
    End With
    
    strEmail = Left(strEmail, Len(strEmail) - 1)
    
    DoCmd.SendObject , , , , , strEmail, , , True, False

End Sub

The rs.open will obviosly not work how it currently is but I would like the if statement to open one of those four based on which button I press.

CodePudding user response：

Sub EmailQuery(strQueryName as string)

    Dim cn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim strEmail As String
   
    Set cn = CurrentProject.Connection
    Set rs = New ADODB.Recordset
    rs.Open strQueryName, cn
    With rs
   .movelast 
   .movefirst


        Do While Not .EOF
            strEmail = strEmail & .Fields("Email") & ";"
            .MoveNext
        Loop
        .Close
    End With
    
    strEmail = Left(strEmail, Len(strEmail) - 1)
    
    DoCmd.SendObject , , , , , strEmail, , , True, False

End Sub

'EmailQuery is a sub so no () around parameters
Private Sub cmdAllSuppliers_Click()
EmailQuery strQryAll 
End Sub