Building the Standard Modules | Beginning Access 2007 VBA

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

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.

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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