|
|
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.
 |
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.
|
|
|