Using Modules to Neaten My Code...

[saross]

Hi everyone. I'm very proud of the following code which I managed to work out myself:

If Me.ChkHealth = True Then
intSubCat = 1

strSQL = "SELECT TBLContractSubCat.ContractID, TBLContractSubCat.SubCatID FROM TBLContractSubCat "
strSQL = strSQL & "WHERE (((TBLContractSubCat.ContractID)="
strSQL = strSQL & lngContractID & ") AND ((TBLContractSubCat.SubCatID)="
strSQL = strSQL & intSubCat & "));"

Set db = CurrentDb()
Set rsCheck = db.OpenRecordset(strSQL)

If rsCheck.RecordCount = 0 Then
Set rsContractSubCat = db.OpenRecordset("TBLContractSubCat", dbOpenTable, dbAppendOnly)
rsContractSubCat.AddNew
rsContractSubCat("ContractID") = lngContractID
rsContractSubCat("SubCatID") = intSubCat
rsContractSubCat.Update
rsContractSubCat.Close
End If
End If

However, I need to repeat it for several check buttons using different integers for each one so can someone tell me how I go about creating a module or function for the middle section which I can just call in rather than repeating the lines of code. I'd like to learn how to keep it clean...

 

[Surjer]

Place this code in a module called anything...

    Public Function MyNewFunction(ByVal intSubCat As Integer, ByVal lngContractID As Integer) As Boolean
        On Error GoTo MyNewFunctionERRHand
        Dim strSQL As String
        strSQL = "SELECT TBLContractSubCat.ContractID, TBLContractSubCat.SubCatID FROM TBLContractSubCat "
        strSQL = strSQL & "WHERE (((TBLContractSubCat.ContractID)="
        strSQL = strSQL & lngContractID & ") AND ((TBLContractSubCat.SubCatID)="
        strSQL = strSQL & intSubCat & "));"

        'Dim these next few variables with whatever kinda connection you are using
        'Dim db As DAO.Database
        'Dim rsContractSubCat As DAO.Recordset
        'Dim rsCheck As DAO.Recordset

        db = CurrentDb
        rsCheck = db.OpenRecordset(strSQL)

        If rsCheck.RecordCount = 0 Then
            rsContractSubCat = db.OpenRecordset("TBLContractSubCat", dbOpenTable, dbAppendOnly)
            rsContractSubCat.AddNew()
            rsContractSubCat("ContractID") = lngContractID
            rsContractSubCat("SubCatID") = intSubCat
            rsContractSubCat.Update()
            rsContractSubCat.Close()
        End If
MyNewFunctionERRHand:
        If Err.Number > 0 Then
            MyNewFunction = False
              msgbox err.Number & " " & err.description
              Exit Function
        Else
            MyNewFunction = True
        End If
    End Function

and then you can use it by doing this

Dim MyFunctionRanOK as Boolean
MyFunctionRanOK = MyNewFunction (intsubcat, lngcontractID)

 

[saross]

Thanks very much.