Now that you have created the properties and methods for the Customer objects, you are ready to begin writing the code in the standard modules.
Try It Out-Building the modBusinessLogic and modDatabaseLogic Modules
The modBusinessLogic module will contain business logic but will not contain any database access calls. The modDatabaseLogic module will contain calls that are specific to the database. Let’s create these modules.
Insert a new standard module called modBusinessLogic. Add the following code to the General Declarations of the module:
Option Compare Database Option Explicit Const BUS_LOGIC = "modBusinessLogic" Public intCustomerLookupId As Integer
Add the following FixNull function to the modBusinessLogic module:
Function FixNull(varIn As Variant) As String 'this procedure sets null values in the recordset 'to a null string so an error does not occur when 'trying to assign the value to a control for display 'if the value is null If IsNull(varIn) Then FixNull = "" Else 'return the value passed in FixNull = varIn End If End Function
Add the following PopulateListFromRecordset procedure to the modBusinessLogic module:
Sub PopulateListFromRecordset(lstList As ListBox, rsRecordset As _ ADODB.Recordset, intNumCols As Integer) On Error GoTo HandleError Dim intCounter As Integer Dim strItem As String With lstList .RowSource = "" .ColumnCount = intNumCols .RowSourceType = "Value List" End With 'add all of the values in the recordset to the list box Do Until rsRecordset.EOF 'for each item in the current record, build string For intCounter = 0 To intNumCols - 1 strItem = strItem & rsRecordset(intCounter).Value & ";" Next intCounter lstList.AddItem (strItem) strItem = "" rsRecordset.MoveNext Loop Exit Sub HandleError: GeneralErrorHandler Err.Number, Err.Description, BUS_LOGIC, _ "PopulateListFromRecordset" Exit Sub End Sub
Add the following MoveToFirstRecord procedure to the modBusinessLogic module:
Sub MoveToFirstRecord(rsRecordset As ADODB.Recordset, objObject As Object, _ blnAddMode As Boolean) On Error GoTo HandleError 'move to the first record in the local disconnected recordset If Not rsRecordset.BOF And Not rsRecordset.EOF Then rsRecordset.MoveFirst 'add code to populate object with new current record objObject.PopulatePropertiesFromRecordset rsRecordset blnAddMode = False End If Exit Sub HandleError: GeneralErrorHandler Err.Number, Err.Description, BUS_LOGIC, _ "MoveToFirstRecord" Exit Sub End Sub
Add the following MoveToLastRecord procedure to the modBusinessLogic module:
Sub MoveToLastRecord(rsRecordset As ADODB.Recordset, objObject As Object, _ blnAddMode As Boolean) On Error GoTo HandleError 'move to the last record in the local disconnected recordset If Not rsRecordset.BOF And Not rsRecordset.EOF Then rsRecordset.MoveLast 'add code to populate object with new current record objObject.PopulatePropertiesFromRecordset rsRecordset blnAddMode = False End If Exit Sub HandleError: GeneralErrorHandler Err.Number, Err.Description, BUS_LOGIC, _ "MoveToLastRecord" Exit Sub End Sub
Add the following MoveToPreviousRecord procedure to the modBusinessLogic module:
Sub MoveToPreviousRecord(rsRecordset As ADODB.Recordset, objObject As Object, _ blnAddMode As Boolean) On Error GoTo HandleError 'move to the previous record in the local disconnected recordset 'if not already at the beginning If Not rsRecordset.BOF Then rsRecordset.MovePrevious blnAddMode = False 'make sure not past beginning of recordset now If Not rsRecordset.BOF Then 'add code to populate object with new current record objObject.PopulatePropertiesFromRecordset rsRecordset Else 'at beginning of recordset so move to next record rsRecordset.MoveNext End If End If Exit Sub HandleError: GeneralErrorHandler Err.Number, Err.Description, BUS_LOGIC, _ "MoveToPreviousRecord" Exit Sub End Sub
Add the following MoveToNextRecord procedure to the modBusinessLogic module:
Sub MoveToNextRecord(rsRecordset As ADODB.Recordset, objObject As Object, _ blnAddMode As Boolean) On Error GoTo HandleError 'move to the next record in the local disconnected recordset 'if not already at the end If Not rsRecordset.EOF Then rsRecordset.MoveNext blnAddMode = False 'make sure not past end of recordset If Not rsRecordset.EOF Then 'add code to populate object with new current record objObject.PopulatePropertiesFromRecordset rsRecordset Else 'at end of recordset so move back one rsRecordset.MovePrevious End If End If Exit Sub HandleError: GeneralErrorHandler Err.Number, Err.Description, BUS_LOGIC, _ "MoveToNextRecord" Exit Sub End Sub
Add the following GeneralErrorHandler procedure to the modBusinessLogic module:
Public Sub GeneralErrorHandler(lngErrNumber As Long, strErrDesc As String, _ strModuleSource As String, strProcedureSource As String) On Error Resume Next Dim strMessage As String 'build the error message string from the parameters passed in strMessage = "An error has occurred in the application." strMessage = strMessage & vbCrLf & "Error Number: " & lngErrNumber strMessage = strMessage & vbCrLf & "Error Description: " & strErrDesc strMessage = strMessage & vbCrLf & "Module Source: " & strModuleSource strMessage = strMessage & vbCrLf & "Procedure Source: " & strProcedureSource 'display the message to the user MsgBox strMessage, vbCritical Exit Sub End Sub
Save your changes to the modBusinessLogic module.
Insert a new standard module called modDatabaseLogic. Add the following code to the General Declarations of the module:
Option Compare Database Option Explicit Dim cnConn As ADODB.Connection Dim strConnection As String Const DB_LOGIC = "modDatabaseLogic"
Add the following OpenDbConnection procedure to the modDatabaseLogic module. You will need to modify the strConnection string to point to your SQL Server database. If you are not using integrated security, you must specify the user ID and password (User Id=sa; Password=password;) in place of the Integrated Security option (Integrated Security=SSPI;).
Sub OpenDbConnection() On Error GoTo HandleError strConnection = "Provider=sqloledb;Data Source=goz_tablet1100\sqldev;" & _ "Integrated Security=SSPI;Initial Catalog=CustomerServiceSQL" 'create a new connection instance and open it using the connection string Set cnConn = New ADODB.Connection cnConn.Open strConnection Exit Sub HandleError: GeneralErrorHandler Err.Number, Err.Description, DB_LOGIC, _ "OpenDbConnection" Exit Sub End Sub
Add the following CloseDbConnection procedure to the modDatabaseLogic module:
Sub CloseDbConnection() On Error GoTo HandleError 'close the database connection cnConn.Close Set cnConn = Nothing Exit Sub HandleError: GeneralErrorHandler Err.Number, Err.Description, DB_LOGIC, _ "CloseDbConnection" Exit Sub End Sub
Add the following ProcessRecordset function to the modDatabaseLogic module:
Function ProcessRecordset(strSQLStatement As String) As ADODB.Recordset On Error GoTo HandleError 'open the connection to the database Call OpenDbConnection 'create a new instance of a recordset Dim rsCont As New ADODB.Recordset 'set various properties of the recordset With rsCont 'specify a cursortype and lock type that will allow updates .CursorType = adOpenKeyset .CursorLocation = adUseClient .LockType = adLockBatchOptimistic 'populate the recordset based on SQL statement .Open strSQLStatement, cnConn 'disconnect the recordset .ActiveConnection = Nothing End With 'close the connection to the database Call CloseDbConnection 'return the recordset Set ProcessRecordset = rsCont Exit Function HandleError: GeneralErrorHandler Err.Number, Err.Description, DB_LOGIC, _ "ProcessRecordset" Exit Function End Function
Add the following BuildSQLSelectFrom function to the modDatabaseLogic module:
Function BuildSQLSelectFrom() As String On Error GoTo HandleError 'create SELECT FROM part of SQL Statement BuildSQLSelectFrom = "SELECT CustomerID, FirstName, LastName, " & _ " Company, Address1, City, Region, PostalCode, " & _ " HomePhone, WorkPhone, CellPhone FROM tblCustomers " Exit Function HandleError: GeneralErrorHandler Err.Number, Err.Description, DB_LOGIC, _ "BuildSQLSelectFrom" Exit Function End Function
Add the following BuildSQLWhere function to the modDatabaseLogic module:
Function BuildSQLWhere(blnPriorWhere As Boolean, strPriorWhere As String, _ strValue As String, strDbFieldName As String) As String On Error GoTo HandleError Dim strWhere As String If blnPriorWhere Then 'add to the existing where clause strWhere = strPriorWhere & " AND " Else 'create the where clause for the first time strWhere = " WHERE " End If If strDbFieldName = "Phone" Then 'search each of phone fields in the db for this value to see 'if exact match or starts with this value for any one of the 'phone fields strWhere = strWhere & "(HomePhone LIKE '" & PadQuotes(strValue) & "%'" & _ " OR WorkPhone LIKE '" & PadQuotes(strValue) & "%'" & _ " OR CellPhone LIKE '" & PadQuotes(strValue) & "%')" Else 'build where clause using LIKE so will find both exact 'matches and those that start with value input by user strWhere = strWhere & strDbFieldName & " LIKE '" & PadQuotes(strValue) & _ "%' " End If blnPriorWhere = True 'return where clause BuildSQLWhere = strWhere Exit Function HandleError: GeneralErrorHandler Err.Number, Err.Description, DB_LOGIC, "BuildSQLWhere" Exit Function End Function
Add the following PadQuotes function to the modDatabaseLogic module:
Function PadQuotes(strIn As String) As String 'This function replaces the occurrence of single 'quotes with two single quotes in a row. 'This is to eliminate errors in SQL Server and other 'databases when a user includes an apostrophe in the 'data value, and helps to enhance application security. On Error GoTo HandleError PadQuotes = Replace(strIn, "'", "''") Exit Function HandleError: GeneralErrorHandler Err.Number, Err.Description, DB_LOGIC, "PadQuotes" Exit Function End Function
Add the following ExecuteSPRetrieveRS function to the modDatabaseLogic module:
Function ExecuteSPRetrieveRS(strSPname As String, Optional intCustomerId _ As Integer) As ADODB.Recordset On Error GoTo HandleError Dim parCustId As ADODB.Parameter Dim cmdCommand As ADODB.Command Dim rsCustomers As ADODB.Recordset 'set up the command object for executing stored procedure Set cmdCommand = New ADODB.Command cmdCommand.CommandType = adCmdStoredProc Set rsCustomers = New ADODB.Recordset 'if the customer id is specified and greater than 0 If Not IsMissing(intCustomerId) And intCustomerId > 0 Then 'Add parameter to be passed to stored procedure Set parCustId = cmdCommand.CreateParameter("CustomerId", _ adInteger, adParamInput) parCustId.Value = intCustomerId cmdCommand.Parameters.Append parCustId End If 'set stored procedure name cmdCommand.CommandText = strSPname 'open the database connection Call OpenDbConnection 'set the command object to the current connection Set cmdCommand.ActiveConnection = cnConn 'Create recordset by executing the command With rsCustomers .CursorLocation = adUseClient .CursorType = adOpenStatic .LockType = adLockBatchOptimistic Set .Source = cmdCommand .Open End With Set rsCustomers.ActiveConnection = Nothing 'close the database connection Call CloseDbConnection 'return the recordset Set ExecuteSPRetrieveRS = rsCustomers Exit Function HandleError: GeneralErrorHandler Err.Number, Err.Description, DB_LOGIC, _ "RetrieveCustomersDb" Exit Function End Function
Add the following ProcessUpdate procedure to the modDatabaseLogic module:
Sub ProcessUpdate(strSPname As String, objCust As clsCustomer, Optional _ rsCust As ADODB.Recordset) On Error GoTo HandleError 'This procedure is used to handle updates to the database 'open the connection to the database Call OpenDbConnection 'execute the stored procedure Call ExecuteStoredProcedure(strSPname, objCust) 'close the connection to the database Call CloseDbConnection Exit Sub HandleError: GeneralErrorHandler Err.Number, Err.Description, DB_LOGIC, "ProcessUpdate" Exit Sub End Sub
Add the following ExecuteStoredProcedure procedure to the modDatabaseLogic module:
Sub ExecuteStoredProcedure(strSPname As String, objCust As clsCustomer) On Error GoTo HandleError 'the purpose of this procedure is to execute 'a stored procedure that does not return any 'rows against the database. Dim cmdCommand As ADODB.Command Set cmdCommand = New ADODB.Command 'set up the command object for executing stored procedure cmdCommand.CommandType = adCmdStoredProc Call AddParameters(strSPname, cmdCommand, objCust) 'set the command to the current connection Set cmdCommand.ActiveConnection = cnConn 'set the SQL statement to the command text cmdCommand.CommandText = strSPname 'execute the command against the database cmdCommand.Execute Exit Sub HandleError: GeneralErrorHandler Err.Number, Err.Description, DB_LOGIC, _ "ExecuteStoredProcedure" Exit Sub End Sub
Add the following AddParameters procedure to the modDatabaseLogic module:
Sub AddParameters(strSPname As String, cmdCommand As ADODB.Command, objCust _ As clsCustomer) On Error GoTo HandleError Dim parParm As ADODB.Parameter 'if updating existing record If strSPname = "spUpdateCustomer" Then 'Add parameter for existing Customer Id to be passed to stored procedure Set parParm = cmdCommand.CreateParameter("CustomerId", adInteger, _ adParamInput) cmdCommand.Parameters.Append parParm parParm.Value = objCust.CustomerId End If 'Add parameter for Last Name to be passed to stored procedure Set parParm = cmdCommand.CreateParameter("LastName", adVarChar, _ adParamInput, 50) parParm.Value = objCust.LastName cmdCommand.Parameters.Append parParm 'Add parameter for First Name to be passed to stored procedure Set parParm = cmdCommand.CreateParameter("FirstName", adVarChar, _ adParamInput, 50) parParm.Value = objCust.FirstName cmdCommand.Parameters.Append parParm 'Add parameter for Middle Name to be passed to stored procedure Set parParm = cmdCommand.CreateParameter("MiddleName", adVarChar, _ adParamInput, 50) parParm.Value = objCust.MiddleName cmdCommand.Parameters.Append parParm 'Add parameter for Company Name to be passed to stored procedure Set parParm = cmdCommand.CreateParameter("Company", adVarChar, _ adParamInput, 50) parParm.Value = objCust.Company cmdCommand.Parameters.Append parParm 'Add parameter for Address1 to be passed to stored procedure Set parParm = cmdCommand.CreateParameter("Address1", adVarChar, _ adParamInput, 100) parParm.Value = objCust.Address1 cmdCommand.Parameters.Append parParm 'Add parameter for Address2 to be passed to stored procedure Set parParm = cmdCommand.CreateParameter("Address2", adVarChar, _ adParamInput, 100) parParm.Value = objCust.Address2 cmdCommand.Parameters.Append parParm 'Add parameter for City to be passed to stored procedure Set parParm = cmdCommand.CreateParameter("City", adVarChar, _ adParamInput, 50) parParm.Value = objCust.City cmdCommand.Parameters.Append parParm 'Add parameter for Region to be passed to stored procedure Set parParm = cmdCommand.CreateParameter("Region", adVarChar, _ adParamInput, 50) parParm.Value = objCust.Region cmdCommand.Parameters.Append parParm 'Add parameter for Postal Code to be passed to stored procedure Set parParm = cmdCommand.CreateParameter("PostalCode", adVarChar, _ adParamInput, 25) parParm.Value = objCust.PostalCode cmdCommand.Parameters.Append parParm 'Add parameter for Work Phone to be passed to stored procedure Set parParm = cmdCommand.CreateParameter("WorkPhone", adVarChar, _ adParamInput, 15) parParm.Value = objCust.WorkPhone cmdCommand.Parameters.Append parParm 'Add parameter for Home Phone to be passed to stored procedure Set parParm = cmdCommand.CreateParameter("HomePhone", adVarChar, _ adParamInput, 15) parParm.Value = objCust.HomePhone cmdCommand.Parameters.Append parParm 'Add parameter for Cell Phone to be passed to stored procedure Set parParm = cmdCommand.CreateParameter("CellPhone", adVarChar, _ adParamInput, 15) parParm.Value = objCust.CellPhone cmdCommand.Parameters.Append parParm 'Add parameter for Email to be passed to stored procedure Set parParm = cmdCommand.CreateParameter("Email", adVarChar, _ adParamInput, 50) parParm.Value = objCust.Email cmdCommand.Parameters.Append parParm 'Add parameter for Current Plan Id to be passed to stored procedure Set parParm = cmdCommand.CreateParameter("CurrentPlanId", adInteger, _ adParamInput) parParm.Value = objCust.PlanId cmdCommand.Parameters.Append parParm 'Add parameter for RepName to be passed to stored procedure Set parParm = cmdCommand.CreateParameter("RepName", adVarChar, _ adParamInput, 50) parParm.Value = Application.CurrentUser cmdCommand.Parameters.Append parParm Exit Sub HandleError: GeneralErrorHandler Err.Number, Err.Description, DB_LOGIC, "AddParameters" Exit Sub End Sub
Save your changes to the modDatabaseLogic module.