Previous Page
Next Page

Building the Standard Modules

In the previous section, you created the properties and methods for the Project and Contact objects. In this section, you begin writing the code in the standard modules that conduct a lot of the business logic and data access features for the application. Let’s start with building the standard modules.

Try It Out-Building the modBusinessLogic and modDatabaseLogic Modules
Image from book

The modBusinessLogic module is one of two standard modules you will be creating. The other one is the modDatabaseLogic that will contain calls that are specific to the database. The modBusinessLogic module will not contain any database access calls because you want to keep the data access code in a separate module to make maintenance and future growth easier. You will now turn to the task of creating these modules.

  1. Insert a new standard module called modBusinessLogic. Add the following code to the General Declarations of the module:

    
Option Compare Database
Option Explicit

Public intContactProjectLookup As Integer
Public intContactProjectAdd As Integer

Const BUS_LOGIC As String = "modBusinessLogic"

Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
"GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long

Private Type OPENFILENAME
  lStructSize As Long
  hwndOwner As Long
  hInstance As Long
  lpstrFilter As String
  lpstrCustomFilter As String
  nMaxCustFilter As Long
  nFilterIndex As Long
  lpstrFile As String
  nMaxFile As Long
  lpstrFileTitle As String
  nMaxFileTitle As Long
  lpstrInitialDir As String
  lpstrTitle As String
  flags As Long
  nFileOffset As Integer
  nFileExtension As Integer
  lpstrDefExt As String
  lCustData As Long
  lpfnHook As Long
  lpTemplateName As String
End Type
Public Declare Function ShellExecute _
    Lib "shell32.dll" _
    Alias "ShellExecuteA" ( _
    ByVal hwnd As Long, _
    ByVal lpOperation As String, _
    ByVal lpFile As String, _
    ByVal lpParameters As String, _
    ByVal lpDirectory As String, _
    ByVal nShowCmd As Long) _
    As Long

  1. Add the following OpenFileAttachment procedure to the modBusinessLogic module:

    
Sub OpenFileAttachment(strFile As String)

    On Error GoTo HandleError

        Dim strAction As String
        Dim lngErr As Long

        'open the file attachment
        strAction = "OPEN"
        lngErr = ShellExecute(0, strAction, strFile, "", "", 1)

        Exit Sub

HandleError:
    GeneralErrorHandler Err.Number, Err.Description, BUS_LOGIC, _
           "OpenFileAttachment"
    Exit Sub
End Sub

  2. Add the following GetFileNameBrowse function to the modBusinessLogic module:

    
Function GetFileNameBrowse() As String

    On Error GoTo HandleError

    Dim OpenFile As OPENFILENAME
    Dim lReturn As Long
    Dim sFilter As String
    OpenFile.lStructSize = Len(OpenFile)
    OpenFile.hwndOwner = Forms("frmProjects").hwnd

    sFilter = "All Files (*.*)" & Chr(0) & "*.*" & Chr(0)
    OpenFile.lpstrFilter = sFilter
    OpenFile.nFilterIndex = 1
    OpenFile.lpstrFile = String(257, 0)
    OpenFile.nMaxFile = Len(OpenFile.lpstrFile) - 1
    OpenFile.lpstrFileTitle = OpenFile.lpstrFile
    OpenFile.nMaxFileTitle = OpenFile.nMaxFile
    OpenFile.lpstrInitialDir = "C:"
    OpenFile.lpstrTitle = "Browse for an attachment"
    OpenFile.flags = 0
    lReturn = GetOpenFileName(OpenFile)
    If lReturn = 0 Then
       GetFileNameBrowse = ""
    Else
       'return the selected filename
       GetFileNameBrowse = Trim(OpenFile.lpstrFile)
    End If
    Exit Function

HandleError:
    GeneralErrorHandler Err.Number, Err.Description, BUS_LOGIC, _
           "GetFileNameBrowse"
    Exit Function

End Function

  1. Add the following four recordset navigation procedures to the modBusinessLogic module:

    
Sub MoveToFirstRecord(intRecCounter As Integer, 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
        intRecCounter = 1
        '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

Sub MoveToLastRecord(intRecCounter As Integer, 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
        intRecCounter = rsRecordset.RecordCount
        '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

Sub MoveToPreviousRecord(intRecCounter As Integer, 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
        intRecCounter = intRecCounter - 1

        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
                  intRecCounter = intRecCounter + 1
        End If

    End If
        Exit Sub

HandleError:
    GeneralErrorHandler Err.Number, Err.Description, BUS_LOGIC, _
           "MoveToPreviousRecord"
    Exit Sub

End Sub

Sub MoveToNextRecord(intRecCounter As Integer, 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
        intRecCounter = intRecCounter + 1
        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
            intRecCounter = intRecCounter - 1
        End If

    End If

    Exit Sub

HandleError:
    GeneralErrorHandler Err.Number, Err.Description, BUS_LOGIC, "MoveToNextRecord"
    Exit Sub

End Sub

  1. Add the following ProceedWithDelete function to the modBusinessLogic module:

    
Function ProceedWithDelete(blnAddMode As Boolean) As Boolean

    On Error GoTo HandleError
    Dim blnProceed As Boolean
    Dim intResponse As Integer

    blnProceed = True

    'don't let the user issue a delete command if in add mode
    If blnAddMode = True Then
        blnProceed = False
        ProceedWithDelete = blnProceed
        Exit Function
    End If

    'confirm that user really wants to delete record
    intResponse = MsgBox("Are you sure you want to delete this record?", vbYesNo)

    'if the user cancels delete, then exit this procedure
    If intResponse = vbNo Then
        blnProceed = False

        ProceedWithDelete = blnProceed

        Exit Function
    End If

    ProceedWithDelete = blnProceed

    Exit Function

HandleError:
    ProceedWithDelete = False
    GeneralErrorHandler Err.Number, Err.Description, BUS_LOGIC, _
           "ProceedWithDelete"
    Exit Function

End Function

  1. Add the following GeneralErrorHandler procedure to the modBusinessLogic module. This module will handle all errors for the application and will be referenced in each procedure or function:

    
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

  2. Save your changes to the modBusinessLogic module.

  3. 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 As String = "modDatabaseLogic"

  4. Add the following ExecuteSQLCommand procedure to the modDatabaseLogic module:

    
Sub ExecuteSQLCommand(strSQL As String)

    On Error GoTo HandleError

    'the purpose of this procedure is to execute
    'a SQL statement that does not return any
    'rows against the database.

    Dim cmdCommand As ADODB.Command
    Set  cmdCommand = New ADODB.Command

    'set the command to the current connection
    Set cmdCommand.ActiveConnection = cnConn
    'set the SQL statement to the command text
    cmdCommand.CommandText = strSQL
    'execute the command against the database
    cmdCommand.Execute

        Exit Sub

HandleError:
    GeneralErrorHandler Err.Number, Err.Description, DB_LOGIC, "ExecuteSQLCommand"
    Exit Sub

End Sub

  1. Add the following procedures to the modDatabaseLogic module. You will need to modify the strConnection string, shown in the following code, to point to the path on your computer where the ProjectTrackerDb you created at the beginning of this chapter is located.

    
Sub OpenDbConnection()

    On Error GoTo HandleError

    strConnection = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                    "Data Source=" & CurrentProject.Path &
                    "ProjectTrackerDb.accdb;"

        'create an 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

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

  1. Add the following RequeryRecordset procedure to the modDatabaseLogic module:

    
Sub RequeryRecordset(rsRecordset As ADODB.Recordset)

    On Error GoTo HandleError

    'repopulate the recordset to make sure it contains
    'the most current values from the database.  also
    'disconnect the recordset
    Set rsRecordset.ActiveConnection = cnConn
    rsRecordset.Requery
    Set rsRecordset.ActiveConnection = Nothing

        Exit Sub

HandleError:
    GeneralErrorHandler Err.Number, Err.Description, DB_LOGIC, "RequeryRecordset"
    Exit Sub

End Sub

  2. Add the following procedures to the modDatabaseLogic module. These procedures build SQL statements that are used to make updates to the tblContacts table.

    
Function BuildSQLInsertContacts(objCurrContact As clsContacts) As String

    On Error GoTo HandleError

        Dim strSQLInsert As String

    'create SQL to insert a new record into the database
    'containing the values in the Contacts object
    strSQLInsert = "INSERT INTO tblContacts(" & _
        "txtLastName, txtFirstName, txtMiddleName, " & _
        "txtCompany, txtAddress1, txtAddress2, " & _
        "txtCity, txtRegion, txtPostalCode, " & _
        "txtWorkPhone, txtHomePhone, txtCellPhone, " & _
        "txtEmail) VALUES (" & _
        "'" & objCurrContact.LastName & "', " & _
        "'" & objCurrContact.FirstName & "', " & _
        "'" & objCurrContact.MiddleName & "', " & _
        "'" & objCurrContact.Company & "', " & _
        "'" & objCurrContact.Address1 & "', " & _
        "'" & objCurrContact.Address2 & "', " & _
        "'" & objCurrContact.City & "', " & _
        "'" & objCurrContact.Region & "', " & –_
        "'" & objCurrContact.PostalCode & "', " & _
        "'" & objCurrContact.WorkPhone & "', " & _
        "'" & objCurrContact.HomePhone & "', " & _
        "'" & objCurrContact.CellPhone & "', " & _
        "'" & objCurrContact.Email & "') "
        BuildSQLInsertContacts = strSQLInsert

        Exit Function

HandleError:
    GeneralErrorHandler Err.Number, Err.Description, DB_LOGIC,
"BuildSQLInsertContacts"
    Exit Function

End Function
Function BuildSQLUpdateContacts(objCurrContact As clsContacts) As String

        On Error GoTo HandleError

        Dim strSQLUpdate As String

    'create SQL to update the existing record in the
    'database with the values in the contact object
    strSQLUpdate = "UPDATE tblContacts SET " & _
        "txtLastName = '" & objCurrContact.LastName & "', " & _
        "txtFirstName = '" & objCurrContact.FirstName & "', " & –_
        "txtMiddleName = '" & objCurrContact.MiddleName & "', " & _
        "txtcompany = '" & objCurrContact.Company & "', " & _
        "txtAddress1 = '" & objCurrContact.Address1 & "', " & _
        "txtAddress2 = '" & objCurrContact.Address2 & "', " & _
        "txtCity = '" & objCurrContact.City & "', " & _
        "txtRegion = '" & objCurrContact.Region & "', " & _
        "txtPostalCode = '" & objCurrContact.PostalCode & "', " & _
        "txtWorkPhone = '" & objCurrContact.WorkPhone & "', " & _
        "txtHomePhone = '" & objCurrContact.HomePhone & "', " & _
        "txtCellPhone = '" & objCurrContact.CellPhone & "', " & _
        "txtEmail = '" & objCurrContact.Email & "' " & –_
        "WHERE intContactId = " & objCurrContact.ContactId

    BuildSQLUpdateContacts = strSQLUpdate
        Exit Function

HandleError:
    GeneralErrorHandler Err.Number, Err.Description, DB_LOGIC, _
           "BuildSQLUpdateContacts"
    Exit Function

End Function

Function BuildSQLDeleteContacts(intId As Integer) As String

    On Error GoTo HandleError
    'generate SQL command to delete current record
    Dim strSQLDelete As String
    strSQLDelete = "DELETE FROM tblContacts WHERE intContactId = " & intId
        BuildSQLDeleteContacts = strSQLDelete

    Exit Function

HandleError:
    GeneralErrorHandler Err.Number, Err.Description, DB_LOGIC, _
           "BuildSQLDeleteContacts"
    Exit Function

End Function

Function BuildSQLSelectContacts() As String

    On Error GoTo HandleError
    Dim strSQLRetrieve As String
    'if the intId is not included, retrieve all contacts
    If intContactProjectLookup = 0 Then
    'generate SQL command to retrieve contacts records
    strSQLRetrieve = "SELECT * FROM tblContacts " & _
            "ORDER BY txtLastName, txtFirstName, txtMiddleName"
    Else
    'look up particular contacts record
    strSQLRetrieve = "SELECT * FROM tblContacts " & _
            "WHERE intContactId = " & intContactProjectLookup & _
            " ORDER BY txtLastName, txtFirstName, txtMiddleName"
        End If

        BuildSQLSelectContacts = strSQLRetrieve
  
        Exit Function

HandleError:
    GeneralErrorHandler Err.Number, Err.Description, DB_LOGIC, _
           "BuildSQLSelectContacts"
    Exit Function

End Function

  1. Add the following procedures to the modDatabaseLogic module. These procedures build SQL statements that are used to make updates to the tblProjects table.

    
Function BuildSQLInsertProjects(objCurrProject As clsProjects) As String

    On Error GoTo HandleError

        Dim strSQLInsert As String
        'create SQL to insert a new record into the database
    'containing the values in the Projects object
    strSQLInsert = "INSERT INTO tblProjects(" & _
        "txtProjectTitle, txtProjectDescription, txtPriority, " & _
        "txtReferenceNum, curMoneyBudget, curMoneyToDate, " & _
        "intHoursBudget, intHoursToDate, dtDateDue, " & _
        "txtStatus) VALUES (" & _
        "'" & objCurrProject.ProjectTitle & "', " & _
        "'" & objCurrProject.ProjectDescription & "', " & _
        "'" & objCurrProject.Priority & "', " & _
        "'" & objCurrProject.ReferenceNum & "', " & _
        objCurrProject.MoneyBudget & ", " & _
        objCurrProject.MoneyToDate & ", " & _
        "" & objCurrProject.HoursBudget & ", " & _
        "" & objCurrProject.HoursToDate & ", " & _
        "'" & objCurrProject.DateDue & "', " & _
        "'" & objCurrProject.Status & "') "

        BuildSQLInsertProjects = strSQLInsert

        Exit Function

HandleError:
    GeneralErrorHandler Err.Number, Err.Description, DB_LOGIC, _
           "BuildSQLInsertProjects"
    Exit Function

End Function

Function BuildSQLUpdateProjects(objCurrProject As clsProjects) As String

    On Error GoTo HandleError

        Dim strSQLUpdate As String

        'create SQL to update the existing record in the
    'database with the values in the Project object

    strSQLUpdate = "UPDATE tblProjects SET " & _
        "txtProjectTitle = '" & objCurrProject.ProjectTitle & "', " & _
        "txtProjectDescription = '" & objCurrProject.ProjectDescription & "', " & _
        "txtPriority = '" & objCurrProject.Priority & "', " & _
        "txtReferenceNum = '" & objCurrProject.ReferenceNum & "', " & _
        "curMoneyBudget = '" & objCurrProject.MoneyBudget & "', " & _
        "curMoneyToDate = '" & objCurrProject.MoneyToDate & "', " & _
        "intHoursBudget = " & objCurrProject.HoursBudget & ", " & _
        "intHoursToDate = " & objCurrProject.HoursToDate & ", " & _
        "dtDateDue = '" & objCurrProject.DateDue & "', " & _
        "txtStatus = '" & objCurrProject.Status & "' " & _
        "WHERE intProjectId = " & objCurrProject.ProjectId
        BuildSQLUpdateProjects = strSQLUpdate
        Exit Function

HandleError:
    GeneralErrorHandler Err.Number, Err.Description, DB_LOGIC, _
           "BuildSQLUpdateProjects"
    Exit Function

End Function

Function BuildSQLDeleteProjects(intId As Integer) As String

    On Error GoTo HandleError
        'generate SQL command to delete current record
    Dim strSQLDelete As String
    strSQLDelete = "DELETE FROM tblProjects WHERE intProjectId = " & intId
        BuildSQLDeleteProjects = strSQLDelete
        Exit Function

HandleError:
    GeneralErrorHandler Err.Number, Err.Description, DB_LOGIC, _
           "BuildSQLDeleteProjects"
    Exit Function

End Function

Function BuildSQLSelectProjects(blnAllRecords As Boolean) As String

    On Error GoTo HandleError
        'generate SQL command to retrieve projects records
    Dim strSQLRetrieve As String
        'if option to display all records is selected in toggle button
    If blnAllRecords Then

            strSQLRetrieve = "SELECT * FROM tblProjects " & _
            "ORDER BY intProjectId"

    Else
        'show only the unclosed projects
        strSQLRetrieve = "SELECT * " & _
            "FROM tblProjects WHERE txtStatus <> 'Closed’ " & _
            "ORDER BY intProjectId "
                End If
        BuildSQLSelectProjects = strSQLRetrieve
        Exit Function

HandleError:
    GeneralErrorHandler Err.Number, Err.Description, DB_LOGIC, _
           "BuildSQLSelectProjects"
    Exit Function

End Function

Function BuildSQLSelectAll(strTableName) As String

    On Error GoTo HandleError

        Dim strSQLSelect As String

        'use this for selecting all records in a table
    strSQLSelect = "SELECT * FROM " & strTableName

        BuildSQLSelectAll = strSQLSelect
        Exit Function

HandleError:
    GeneralErrorHandler Err.Number, Err.Description, DB_LOGIC, "BuildSQLSelectAll"
    Exit Function

End Function

  1. Add the following ProcessRecordset procedure 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
        'sort the recordset
    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

  2. Add the following ProcessUpdate procedure to the modDatabaseLogic module:

    
Sub ProcessUpdate(strSQLStatement As String, Optional rsRecordset 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 command against the database
   Call ExecuteSQLCommand(strSQLStatement)

       If Not rsRecordset Is Nothing Then
       'repopulate the recordset with most current data
       Call RequeryRecordset(rsRecordset)
   End If
   'close the connection to the database
   Call CloseDbConnection

       Exit Sub

HandleError:
    GeneralErrorHandler Err.Number, Err.Description, DB_LOGIC, "ProcessUpdate"
    Exit Sub

End Sub

  1. Add the following procedures to the modDatabaseLogic module that handle deleting records from the cross-reference tables that store comments, contacts, and file attachments for each project:

    
Function BuildSQLDeleteProjectsComments(intProjectId As Integer) As String

    'build SQL statement for deletion

        On Error GoTo HandleError

   Dim strSQLStatement As String

   strSQLStatement = "DELETE FROM tblProjectsComments WHERE intProjectId = " &
                      intProjectId

   BuildSQLDeleteProjectsComments = strSQLStatement
   Exit Function

HandleError:
    GeneralErrorHandler Err.Number, Err.Description, DB_LOGIC, _
           "BuildSQLDeleteProjectsComments"
    Exit Function

End Function

Function BuildSQLDeleteProjectsContacts(intProjectId As Integer) As String

       'build SQL statement for deletion
        On Error GoTo HandleError

       Dim strSQLStatement As String

       strSQLStatement = "DELETE FROM tblProjectsContacts WHERE intProjectId = "& _
                      intProjectId

       BuildSQLDeleteProjectsContacts = strSQLStatement

       Exit Function

HandleError:
    GeneralErrorHandler Err.Number, Err.Description, DB_LOGIC, _
           "BuildSQLDeleteProjectsContacts"
    Exit Function

End Function

Function BuildSQLDeleteProjectsAttachments(intProjectId As Integer) As String

    'build SQL statement for deletion
        On Error GoTo HandleError


    Dim strSQLStatement As String

        strSQLStatement = "DELETE FROM tblProjectsFileAttachments WHERE " & _
                      "intProjectId = " & intProjectId
        BuildSQLDeleteProjectsAttachments = strSQLStatement

        Exit Function

HandleError:
    GeneralErrorHandler Err.Number, Err.Description, DB_LOGIC, _
           "BuildSQLDeleteProjectsAttachments"
    Exit Function

End Function

  1. Add the following procedures to the modDatabaseLogic module that handle inserting records into the cross-reference tables that store comments, contacts, and file attachments for each project:

    
Function BuildSQLInsertProjectsComments(intProjectId As Integer, strComment _
           As String) As String

 'build SQL statement for insertion
 
  On Error GoTo HandleError

  Dim strSQLStatement As String

  strSQLStatement = "INSERT INTO tblProjectsComments(intProjectId, txtComment)" & _
        "VALUES(" & intProjectId & ", '" & strComment & "')"

  BuildSQLInsertProjectsComments = strSQLStatement
  Exit Function
 
HandleError:
    GeneralErrorHandler Err.Number, Err.Description, DB_LOGIC, _
           "BuildSQLInsertProjectsComments"
    Exit Function

End Function

Functionn BuildSQLInsertProjectsContacts(intContactId As Integer,intProjectId _
         As Integer) As String

    'build SQL statement for insertion
        On Error GoTo HandleError

        Dim strSQLStatement As String

        strSQLStatement = "INSERT INTO tblProjectsContacts(intContactId, " & _
        "intProjectId) VALUES(" & intContactId & ", " & intProjectId & ")"

    BuildSQLInsertProjectsContacts = strSQLStatement
        Exit Function

HandleError:
    GeneralErrorHandler Err.Number, Err.Description, DB_LOGIC, _
           "BuildSQLInsertProjectsContacts"
    Exit Function

End Function

Function BuildSQLInsertProjectsAttachments(intProjectId As Integer, _
         strFileDescription As String, strFileName As String) As String

    'build SQL statement for insertion
       On Error GoTo HandleError
       Dim strSQLStatement As String
       strSQLStatement = "INSERT INTO tblProjectsFileAttachments(intProjectId," & _
       "txtFileDescription, txtFileName) VALUES (" & _
       intProjectId & ", '" & strFileDescription & "', '" & strFileName & "')"
       BuildSQLInsertProjectsAttachments = strSQLStatement
       Exit Function

HandleError:
    GeneralErrorHandler Err.Number, Err.Description, DB_LOGIC, _
           "BuildSQLInsertProjectsAttachments"
    Exit Function

End Function

  1. Save your changes to the modDatabaseLogic module.

How It Works

You created the modBusinessLogic module for processing the business logic for the application, and the modDatabaseLogic module for communicating with the database. In the General Declarations section of the modBusinessLogic module, you added some declarations to external functions. The GetOpenFileName external function is used to display the File Open dialog box that allows you to browse the file system and select a file. This function is called later in the code to open the dialog box for selecting an attachment to associate with a particular project record.

Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias __
"GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long

Private Type OPENFILENAME
  lStructSize As Long
  hwndOwner As Long
  hInstance As Long
  lpstrFilter As String
  lpstrCustomFilter As String
  nMaxCustFilter As Long
  nFilterIndex As Long
  lpstrFile As String
  nMaxFile As Long
  lpstrFileTitle As String
  nMaxFileTitle As Long
  lpstrInitialDir As String
  lpstrTitle As String
  flags As Long
  nFileOffset As Integer
  nFileExtension As Integer
  lpstrDefExt As String
  lCustData As Long
  lpfnHook As Long
  lpTemplateName As String
End Type

The ShellExecute external function is used to launch an external program:

Public Declare Function ShellExecute _
    Lib "shell32.dll" _
    Alias "ShellExecuteA" ( _
    ByVal hwnd As Long, _
    ByVal lpOperation As String, _
    ByVal lpFile As String, _
    ByVal lpParameters As String, _
    ByVal lpDirectory As String, _
    ByVal nShowCmd As Long) _
    As Long

The OpenFileAttachment procedure calls the ShellExecute external function in order to preview a particular attachment in its native application:

Sub OpenFileAttachment(strFile As String)

    On Error GoTo HandleError

            Dim strAction As String
        Dim lngErr As Long

        'open the file attachment
        strAction = "OPEN"
        lngErr = ShellExecute(0, strAction, strFile, "", "", 1)

        Exit Sub

HandleError:
    GeneralErrorHandler Err.Number, Err.Description, BUS_LOGIC, _
           "OpenFileAttachment"
    Exit Sub
End Sub

As I mentioned previously, the GetOpenFileName external function is used to open a file browser dialog box. This function is called from the GetFileNameBrowse function to allow a user to browse for a file attachment to associate with a project:

Function GetFileNameBrowse() As String

        On Error GoTo HandleError

        Dim OpenFile As OPENFILENAME
    Dim lReturn As Long
    Dim sFilter As String
    OpenFile.lStructSize = Len(OpenFile)
    OpenFile.hwndOwner = Forms("frmProjects").hwnd
    sFilter = "All Files (*.*)" & Chr(0) & "*.*" & Chr(0)
    OpenFile.lpstrFilter = sFilter
    OpenFile.nFilterIndex = 1
    OpenFile.lpstrFile = String(257, 0)
    OpenFile.nMaxFile = Len(OpenFile.lpstrFile) - 1
    OpenFile.lpstrFileTitle = OpenFile.lpstrFile
    OpenFile.nMaxFileTitle = OpenFile.nMaxFile
    OpenFile.lpstrInitialDir = "C:"
    OpenFile.lpstrTitle = "Browse for an attachment"
    OpenFile.flags = 0
    lReturn = GetOpenFileName(OpenFile)
    If lReturn = 0 Then
       GetFileNameBrowse = ""
    Else
    'return the selected filename
       GetFileNameBrowse = Trim(OpenFile.lpstrFile)
    End If

        Exit Function

HandleError:
    GeneralErrorHandler Err.Number, Err.Description, BUS_LOGIC, "GetFileNameBrowse"
    Exit Function

End Function

The code for these external functions is a little bit complicated. It is okay if you do not understand exactly how they work. I just wanted to include the functionality to show you how powerful your Access applications can be.

Next, you added four recordset navigation procedures to the modBusinessLogic module. For example, the MoveToFirstRecord procedure is responsible for moving to the first record in the local disconnected recordset:

Sub MoveToFirstRecord(intRecCounter As Integer, 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
        intRecCounter = 1

Once the record position changes, the object is populated with the new current record:

        '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

The ProceedWithDelete function prompts the user to confirm that she wishes to proceed with a delete operation, such as deleting a project record from frmProjects or deleting a contact record from frmContacts:

Function ProceedWithDelete(blnAddMode As Boolean) As Boolean

    On Error GoTo HandleError

        Dim blnProceed As Boolean
    Dim intResponse As Integer


        blnProceed = True

If the user is in add mode, that user cannot issue a delete command because the record has not even been added yet:

'don't let the user issue a delete command if in add mode
If blnAddMode = True Then
    blnProceed = False
    ProceedWithDelete = blnProceed
    Exit Function
End If

Then, the user is prompted to confirm that she wishes to proceed with the delete operation:

'confirm that user really wants to delete record
intResponse = MsgBox("Are you sure you want to delete this record?", vbYesNo)

The value returned from the MsgBox function is then analyzed to determine whether the user chose the option to proceed with the delete:

    'if the user cancels delete, then exit this procedure
    If intResponse = vbNo Then
        blnProceed = False
        ProceedWithDelete = blnProceed
        Exit Function
    End If

        ProceedWithDelete = blnProceed

        Exit Function

HandleError:
    ProceedWithDelete = False
    GeneralErrorHandler Err.Number, Err.Description, BUS_LOGIC, "ProceedWithDelete"
    Exit Function

End Function

The last procedure added to the modBusinessLogic module was the GeneralErrorHandler procedure. This module handles all errors for the application and is referenced in each procedure or function, as you have probably noticed by now.

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

Next, you created a standard module called modDatabaseLogic. You added various procedures to the module for interacting with the database. For example, the ExecuteSQLCommand procedure is responsible for executing a SQL statement against the database that does not return any rows. Examples of these types of statements include insert, update, and delete statements.

Sub ExecuteSQLCommand(strSQL As String)

    On Error GoTo HandleError

    'the purpose of this procedure is to execute
    'a SQL statement that does not return any
    'rows against the database.

        Dim cmdCommand As ADODB.Command
    Set cmdCommand = New ADODB.Command

        'set the command to the current connection
    Set cmdCommand.ActiveConnection = cnConn
    'set the SQL statement to the command text
    cmdCommand.CommandText = strSQL
    'execute the command against the database
    cmdCommand.Execute

        Exit Sub

HandleError:
    GeneralErrorHandler Err.Number, Err.Description, DB_LOGIC, _
           "ExecuteSQLCommand"

    Exit Sub

End Sub

Next, you added the OpenDbConnection and CloseDbConnection procedures for opening and closing database connections. In the OpenDbConnection procedure, you may have had to modify the strConnection string to point to the path where the ProjectTrackerDb, which you created at the beginning of this chapter, is located.

Sub OpenDbConnection()

    On Error GoTo HandleError

        strConnection = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                    "Data Source=" & CurrentProject.Path &
"ProjectTrackerDb.accdb;"

            '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

The RequeryRecordset procedure was then added to the modDatabaseLogic module to repopulate the values in the recordset with the current data in the underlying database:

Sub RequeryRecordset(rsRecordset As ADODB.Recordset)

    On Error GoTo HandleError

'repopulate the recordset to make sure it contains
    'the most current values from the database.  also
    'disconnect the recordset
    Set rsRecordset.ActiveConnection = cnConn
    rsRecordset.Requery
    Set rsRecordset.ActiveConnection = Nothing

        Exit Sub

HandleError:
    GeneralErrorHandler Err.Number, Err.Description, DB_LOGIC, "RequeryRecordset"
    Exit Sub

End Sub

Next, you added various procedures for creating SQL statements for inserting, updating, deleting, and selecting records from the tblContacts table. For example, the BuildSQLInsertContacts procedure creates a SQL statement from the values in the objCurrContact object:

Function BuildSQLInsertContacts(objCurrContact As clsContacts) As String

    On Error GoTo HandleError

        Dim strSQLInsert As String

        'create SQL to insert a new record into the database
    'containing the values in the Contacts object
    strSQLInsert = "INSERT INTO tblContacts(" & _
        "txtLastName, txtFirstName, txtMiddleName, " & _
        "txtCompany, txtAddress1, txtAddress2, " & _
        "txtCity, txtRegion, txtPostalCode, " & _
        "txtWorkPhone, txtHomePhone, txtCellPhone, " & _
        "txtEmail) VALUES (" & _
        "'" & objCurrContact.LastName & "', " & _
        "'" & objCurrContact.FirstName & "', " & _
        "'" & objCurrContact.MiddleName & "', " & _
        "'" & objCurrContact.Company & "', " & _
        "'" & objCurrContact.Address1 & "', " & _
        "'" & objCurrContact.Address2 & "', " & _
        "'" & objCurrContact.City & "', " & _
        "'" & objCurrContact.Region & "', " & _
        "'" & objCurrContact.PostalCode & "', " & _
        "'" & objCurrContact.WorkPhone & "', " & _
        "'" & objCurrContact.HomePhone & "', " & _
        "'" & objCurrContact.CellPhone & "', " & _
        "'" & objCurrContact.Email & "') "

        BuildSQLInsertContacts = strSQLInsert
        Exit Function

HandleError:
    GeneralErrorHandler Err.Number, Err.Description, DB_LOGIC, _

           "BuildSQLInsertContacts"
    Exit Function

End Function

Similarly, you added various procedures for creating SQL statements. You created procedures for inserting, updating, and deleting project records, for selecting unclosed project records, and for selecting all project records. For example, the BuildSQLInsertProjects procedure creates a SQL statement from the values in the objCurrProject object:

Function BuildSQLInsertProjects(objCurrProject As clsProjects) As String

    On Error GoTo HandleError

        Dim strSQLInsert As String

        'create SQL to insert a new record into the database
    'containing the values in the Projects object
    strSQLInsert = "INSERT INTO tblProjects(" & _
        "txtProjectTitle, txtProjectDescription, txtPriority, " & _
        "txtReferenceNum, curMoneyBudget, curMoneyToDate, " & _
        "intHoursBudget, intHoursToDate, dtDateDue, " & _
        "txtStatus) VALUES (" & _
        "'" & objCurrProject.ProjectTitle & "', " & _
        "'" & objCurrProject.ProjectDescription & "', " & _
        "'" & objCurrProject.Priority & "', " & _
        "'" & objCurrProject.ReferenceNum & "', " & _
        objCurrProject.MoneyBudget & ", " & _
        objCurrProject.MoneyToDate & ", " & _
        "" & objCurrProject.HoursBudget & ", " & _
        "" & objCurrProject.HoursToDate & ", " & _
        "'" & objCurrProject.DateDue & "', " & _
        "'" & objCurrProject.Status & "') "

        BuildSQLInsertProjects = strSQLInsert
        Exit Function

HandleError:
    GeneralErrorHandler Err.Number, Err.Description, DB_LOGIC, _
           "BuildSQLInsertProjects"
    Exit Function

End Function

The ProcessRecordset procedure accepted a SQL statement as a parameter and executed that statement against the database. The database connection was opened, the SQL statement was executed, and the database connection was then closed. The recordset that was populated from the results of the SQL statement was returned to the calling function.

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

Next, the ProcessUpdate procedure was added to the modDatabaseLogic module for processing various updates to the database. This procedure is similar to ProcessRecordset, only it does not return any values after executing the SQL statement.

Sub ProcessUpdate(strSQLStatement As String, Optional rsRecordset 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 command against the database
    Call ExecuteSQLCommand(strSQLStatement)

        If Not rsRecordset Is Nothing Then
        'repopulate the recordset with most current data
        Call RequeryRecordset(rsRecordset)
    End If

'close the connection to the database
    Call CloseDbConnection
        Exit Sub

HandleError:
    GeneralErrorHandler Err.Number, Err.Description, DB_LOGIC, "ProcessUpdate"
    Exit Sub

End Sub

Next, various functions were added to handle deleting records from the cross-reference tables that store comments, contacts, and file attachments for each project. For example, the BuildSQLDelete ProjectsComments function is responsible for creating the SQL statement used to delete comment records for a given project:

Function BuildSQLDeleteProjectsComments(intProjectId As Integer) As String

    'build SQL statement for deletion

        On Error GoTo HandleError

        Dim strSQLStatement As String

        strSQLStatement = "DELETE FROM tblProjectsComments WHERE intProjectId = " &
                      intProjectId

        BuildSQLDeleteProjectsComments = strSQLStatement

        Exit Function

HandleError:
    GeneralErrorHandler Err.Number, Err.Description, DB_LOGIC, _
           "BuildSQLDeleteProjectsComments"

    Exit Function

End Function

Various procedures were also added to handle inserting records into the cross-reference tables that store comments, contacts, and file attachments for each project. For example, the BuildSQLInsertProject Comments function is responsible for creating the SQL statement that inserts a new comment into the tblProjectsComments table in the database:

Function BuildSQLInsertProjectsComments(intProjectId As Integer, strComment _
           As String) As String

   'build SQL statement for insertion

       On Error GoTo HandleError
       Dim strSQLStatement As String

   strSQLStatement = "INSERT INTO tblProjectsComments(intProjectId, txtComment)" & _
         "VALUES(" & intProjectId & ", '" & strComment & "')"

   BuildSQLInsertProjectsComments = strSQLStatement
       Exit Function

HandleError:
    GeneralErrorHandler Err.Number, Err.Description, DB_LOGIC, _
           "BuildSQLInsertProjectsComments"

    Exit Function

End Function
Image from book

Previous Page
Next Page