Try It Out Writing Code for the frmProjects Form

As previously mentioned, you are now ready to write the VBA code that will finish up the application. You will start with the frmProjects form and will finish with the frmContacts form.

1. Open the frmProjects form and select the Form_Load event for the form to bring up the Visual Basic editor. Add the following code to the form:

Private Sub Form_Load()

On Error GoTo HandleError

Set objProjects = New clsProjects Set rsProjects = New ADODB.Recordset

'load non-closed projects as default (open, blnAllRecords = False

on hold, etc.)

'make sure unclosed is enabled by default so togShowUnclosed.Value = True togShowAll.Value = False

only unclosed records load first

Access Form Projects
Figure 12.26

'lock project id field so no edits allowed (primary key assigned by database) txtProjectId.Locked = True

'load the records in the recordset and display the first one on the form Call LoadRecords

Exit Sub

HandleError:

GeneralErrorHandler Err.Number, Err.Description, PROJECTS_FORM, "Form_Load" Exit Sub

End Sub

2. Add the following code to the General Declarations section of the form.

Option Compare Database Option Explicit

Dim blnAddMode As Boolean Dim blnAllRecords As Boolean Dim rsProjects As ADODB.Recordset Dim objProjects As clsProjects Dim rsComments As ADODB.Recordset Dim rsContacts As ADODB.Recordset Dim rsAttachments As ADODB.Recordset Const PROJECTS_FORM = "frmProjects" Dim intCurrProjectRecord As Integer

3. Add Click event procedures to the form for making updates to the data.

Private Sub cmdAddNew_Click() On Error GoTo HandleError

'clear the current controls to enable adding a new

'Project record

Call AddEmptyProjectRecord

Exit Sub

HandleError:

GeneralErrorHandler Err.Number, Err.Description, PROJECTS_FORM,

"cmdAddNew_Click" Exit Sub

End Sub

Private Sub cmdSave_Click()

On Error GoTo HandleError Dim intCurProject As Integer

'save the id of the current record if in update mode If Not blnAddMode Then intCurProject = objProjects.ProjectId

Else intCurProject = 0 End If

'populate object with current info on form objProjects.PopulatePropertiesFromForm

'save all changes to current record objProjects.Save blnAddMode, rsProjects

'save changes in list boxes in tabs 1-3 Call SaveComments Call SaveContacts Call SaveAttachments

'move back to the project that was current before the requery If intCurProject > 0 Then

'move back to the project that was just updated rsProjects.Find "[intProjectId] = " & intCurProject

Else

'if just added new record, move to the beginning of 'the recordset

Call MoveToFirstRecord(intCurrProjectRecord, rsProjects, objProjects, blnAddMode)

End If Exit Sub HandleError:

GeneralErrorHandler Err.Number, Err.Description, PROJECTS_FORM, "cmdSave_Click"

Exit Sub End Sub

Private Sub cmdDelete_Click() On Error GoTo HandleError

'delete the current record from the local disconnected recordset objProjects.Delete objProjects.ProjectId, blnAddMode, rsProjects

'move to the first record in the recordset after the delete Call MoveToFirstRecord(intCurrProjectRecord, rsProjects, objProjects, _ blnAddMode)

'populate the controls on the form with the current record Call PopulateProjectsControls

Exit Sub

HandleError:

GeneralErrorHandler Err.Number, Err.Description, PROJECTS_FORM, _

"cmdDelete_Click" Exit Sub End Sub

4. Add the following Click event procedures to the form for navigating through the data.

Private Sub cmdMoveFirst_Click() On Error GoTo HandleError

'move to the first record in the local disconnected recordset Call MoveToFirstRecord(intCurrProjectRecord, rsProjects, objProjects, _ blnAddMode)

'populate the controls on the form with the current record Call PopulateProjectsControls

HandleError:

GeneralErrorHandler Err.Number, Err.Description, PROJECTS_FORM, _

"cmdMoveFirst_Click" Exit Sub

End Sub

Private Sub cmdMoveLast_Click() On Error GoTo HandleError

'move to the last record in the local disconnected recordset Call MoveToLastRecord(intCurrProjectRecord, rsProjects, objProjects, blnAddMode)

'populate the controls on the form with the current record Call PopulateProjectsControls

Exit Sub

HandleError:

GeneralErrorHandler Err.Number, Err.Description, PROJECTS_FORM, _

"cmdMoveLast_Click" Exit Sub

End Sub

Private Sub cmdMoveNext_Click() On Error GoTo HandleError

'move to the next record in the local disconnected recordset Call MoveToNextRecord(intCurrProjectRecord, rsProjects, objProjects, blnAddMode)

'populate the controls on the form with the current record Call PopulateProjectsControls

Exit Sub

HandleError:

GeneralErrorHandler Err.Number, Err.Description, PROJECTS_FORM, _

"cmdMoveNext_Click" Exit Sub

End Sub

Private Sub cmdMovePrevious_Click() On Error GoTo HandleError

'move to the previous record in the local disconnected recordset Call MoveToPreviousRecord(intCurrProjectRecord, rsProjects, objProjects, blnAddMode)

'populate the controls on the form with the current record Call PopulateProjectsControls Exit Sub

HandleError:

GeneralErrorHandler Err.Number, Err.Description, PROJECTS_FORM, _

"cmdMovePrevious_Click" Exit Sub

End Sub

5. Add the following Click event procedures to the form for managing the contacts associated with a given project.

Private Sub cmdDeleteContact_Click()

On Error GoTo HandleError

'delete the selected contact from the list (not the database, just the screen) If lstContacts.ListIndex >= 0 Then lstContacts.RemoveItem (lstContacts.ListIndex) End If

Exit Sub

HandleError:

GeneralErrorHandler Err.Number, Err.Description, PROJECTS_FORM, _

"cmdDeleteContact_Click" Exit Sub

End Sub

Private Sub cmdManageContacts_Click() On Error GoTo HandleError

'store the current projectid so a contact can be added intContactProjectAdd = objProjects.ProjectId

'open contacts form so user can add contact to existing project DoCmd.OpenForm "frmContacts"

Exit Sub

HandleError:

GeneralErrorHandler Err.Number, Err.Description, PROJECTS_FORM, _

"cmdManageContacts_Click" Exit Sub

End Sub

Private Sub cmdEmailContact_Click() On Error GoTo HandleError

'create a new email to the selected contact using the email column DoCmd.SendObject acSendNoObject, , , lstContacts.Column(5), , , , , True, False

Exit Sub

HandleError:

GeneralErrorHandler Err.Number, Err.Description, PROJECTS_FORM, _

"cmdEmailContact_Click" Exit Sub

End Sub

Private Sub cmdViewContact_Click() On Error GoTo HandleError

'if there is a selected record in the list If lstContacts.ListIndex <> -1 Then

'store the current projectid so a contact can be added intContactProjectAdd = objProjects.ProjectId

'store the current contact so it can be retrieved 'from the contacts form intContactProjectLookup = lstContacts.Column(6) DoCmd.OpenForm "frmContacts"

intContactProjectLookup = 0

End If

Exit Sub

HandleError:

GeneralErrorHandler Err.Number, Err.Description, PROJECTS_FORM, _

"cmdViewContact_Click" Exit Sub End Sub

6. Add the following Click event procedures to the form for managing the comments associated with a given project.

Private Sub cmdAddComment_Click()

On Error GoTo HandleError

'add comment/task to list box lstComments.AddItem (txtAddComment)

'clear AddComment box since you just added it txtAddComment = ""

HandleError:

GeneralErrorHandler Err.Number, Err.Description, PROJECTS_FORM,

"cmdAddComment_Click" Exit Sub

End Sub

Private Sub cmdDeleteComment_Click()

On Error GoTo HandleError

'remove the selected item from the list If lstComments.ListIndex >= 0 Then lstComments.RemoveItem (lstComments.ListIndex) End If

Exit Sub

HandleError:

GeneralErrorHandler Err.Number, Err.Description, PROJECTS_FORM,

"cmdDeleteComment_Click" Exit Sub

End Sub

7. Add the following Click event procedures to the form for managing the file attachments associated with a given project.

Private Sub cmdAddAttachment_Click()

On Error GoTo HandleError

'add file attachment to list box lstFileAttachments.AddItem (txtFileDesc & ";" &

txtFileName)

'clear text boxes since info was added to list txtFileDesc = "" txtFileName = ""

Exit Sub

GeneralErrorHandler Err.Number, Err.Description,

"cmdAddAttachment_Click" Exit Sub

PROJECTS_FORM, _

End Sub

Private Sub cmdFileBrowse_Click()

On Error GoTo HandleError

'show the open dialog and load 'selected file name in text box txtFileName = GetFileNameBrowse

Exit Sub

GeneralErrorHandler Err.Number, Err.Description

"cmdFileBrowse_Click" Exit Sub

, PROJECTS_FORM, _

End Sub

Private Sub cmdOpenFile_Click()

On Error GoTo HandleError

Dim RetVal As Variant Dim strFile As String

'if the user selected a value If lstFileAttachments.ListIndex >= 0 Then

'retrieve the file name from the list box strFile = lstFileAttachments.Column(1)

'open the selected file

Call OpenFileAttachment(strFile)

End If

Exit Sub

GeneralErrorHandler Err.Number, Err.Description

"cmdOpenFile_Click" Exit Sub

, PROJECTS_FORM, _

End Sub

Private Sub cmdRemoveAttachment_Click()

On Error GoTo HandleError

'remove the selected item from the list (if an item has been selected) If lstFileAttachments.ListIndex >= 0 Then lstFileAttachments.RemoveItem (lstFileAttachments.ListIndex) End If

Exit Sub

GeneralErrorHandler Err.Number, Err.Description

"cmdRemoveAttachment_Click" Exit Sub

, PROJECTS_FORM, _

End Sub

8. Add the following AddEmptyProject procedure.

Sub AddEmptyProjectRecord()

On Error GoTo HandleError

'set add mode to true blnAddMode = True

'clear the current values in the Projects object objProjects.ClearObject

'clear the current controls on the form so the 'user can fill in values for the new record Call ClearProjectsControls Exit Sub

HandleError:

GeneralErrorHandler Err.Number, Err.Description, PROJECTS_FORM, _

"AddEmptyProjectRecord" Exit Sub

End Sub

9. Add the following PopulateProjectsControls procedure.

Sub PopulateProjectsControls()

On Error GoTo HandleError

'Populate the controls on the Projects form with the values of the 'current record in the Projects object. If Not rsProjects.BOF And Not rsProjects.EOF Then Me.txtProjectId = objProjects.ProjectId Me.txtProjectTitle = objProjects.ProjectTitle Me.txtProjectDesc = objProjects.ProjectDescription Me.cboPriority = objProjects.Priority Me.txtReferenceNum = objProjects.ReferenceNum Me.txtMoneyBudget = objProjects.MoneyBudget Me.txtMoneyToDate = objProjects.MoneyToDate Me.txtHoursBudget = objProjects.HoursBudget Me.txtHoursToDate = objProjects.HoursToDate If objProjects.DateDue = "1/1/1900" Then Me.txtDateDue = ""

Else

Me.txtDateDue = objProjects.DateDue End If

Me.cboStatus = objProjects.Status

'populate the recordset for tab 1 Set rsComments = New ADODB.Recordset

Set rsComments = objProjects.RetrieveComments(objProjects.

ProjectId)

PopulateListFromRecordset Me.lstComments, rsComments, 1

rsComments.Close

'populate the recordset for tab 2

Set rsContacts = New ADODB.Recordset

Set rsContacts = objProjects.RetrieveContacts(objProjects.

ProjectId)

PopulateListFromRecordset Me.lstContacts, rsContacts, 7

rsContacts.Close

'populate the recordset for tab 3

Set rsAttachments = New ADODB.Recordset

Set rsAttachments = _

objProjects.RetrieveAttachments(objProjects.ProjectId)

PopulateListFromRecordset Me.lstFileAttachments, rsAttachments, 2

rsAttachments.Close

'display the record count on the form

lblRecordNum.Caption = "Record " & intCurrProjectRecord & "

' Of " & _

rsProjects.RecordCount

ElseIf rsProjects.BOF Then

'past beginning of recordset so move to first record

Call MoveToFirstRecord(intCurrProjectRecord, rsProjects,

objProjects, blnAddMode)

ElseIf rsProjects.EOF Then

'past end of recordset so move back to last record

Call MoveToLastRecord(intCurrProjectRecord, rsProjects, _

objProjects, blnAddMode)

End If

Exit Sub

HandleError:

GeneralErrorHandler Err.Number, Err.Description, PROJECTS_FORM, _

"PopulateProjectsControls"

Exit Sub

End

Sub

10.

Add the following ClearProjectControls procedure.

Sub

ClearProjectsControls()

On Error GoTo HandleError

'clear the values in the controls on the form

Me.txtProjectId = ""

Me.txtProjectTitle = ""

Me.txtProjectDesc = ""

Me.cboPriority = 0

Me.txtReferenceNum = ""

Me.txtMoneyBudget = ""

Me.txtMoneyToDate = ""

Me.txtHoursBudget = "" Me.txtHoursToDate = "" Me.txtDateDue = "" Me.cboStatus = 0

'clear the values in the text box controls on the tab control pages Me.txtAddComment = "" Me.txtFileName = "" Me.txtFileDesc = ""

Exit Sub

HandleError:

GeneralErrorHandler Err.Number, Err.Description, PROJECTS_FORM, _

"ClearProjectsControls" Exit Sub

End Sub

11. Add the following PopulateComboBoxes procedure.

Sub PopulateComboBoxes()

On Error GoTo

HandleError

'populate

the priority combo box

cboPriority.RowSource = ""

cboPriority.LimitToList = True

cboPriority.ColumnCount = 1

cboPriority.RowSourceType = "Value List"

cboPriority.AddItem ("Normal")

cboPriority.AddItem ("High")

cboPriority.AddItem ("Low")

'populate

the status combo box

cboStatus.

RowSource = ""

cboStatus.

LimitToList = True

cboStatus.

ColumnCount = 1

cboStatus.

RowSourceType = "Value List"

cboStatus.

.AddItem ("Open")

cboStatus.

.AddItem ("Closed")

cboStatus.

.AddItem ("On Hold")

Exit Sub

HandleError:

GeneralErrorHandler Err.Number, Err.Description, PROJECTS_FORM, _

"PopulateComboBoxes"

Exit Sub

End Sub

12. Add the following PopulateListFromRecordset procedure.

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, PROJECTS_FORM, _

"PopulateListFromRecordset"

Exit Sub

End

Sub

13.

Add the Form_Unload procedure for frmProjects.

Private Sub Form_Unload(Cancel As Integer)

Private Sub Form_Unload(Cancel As Integer)

On Error GoTo HandleError

'close the recordset and free the memory rsProjects.Close

Set rsProjects = Nothing

Exit Sub

HandleError:

GeneralErrorHandler Err.Number, Err.Description, PROJECTS_FORM, â– Form_Unload" Exit Sub

End Sub

Case Study 1: Project Tracker Application

14.

Add the LoadRecords procedure.

Sub

LoadRecords()

On Error GoTo HandleError

intCurrProjectRecord = 0

blnAddMode = False

'populate the main recordset

Set rsProjects = objProjects.RetrieveProjects(blnAllRecords)

'if the recordset is empty

If rsProjects.BOF And rsProjects.EOF Then

Exit Sub

Else

'populate the status and priority combo boxes

Call PopulateComboBoxes

'populate the object with values in the recordset

objProjects.PopulatePropertiesFromRecordset rsProjects

Call MoveToFirstRecord(intCurrProjectRecord, rsProjects, objProjects, _

blnAddMode)

'populate the controls on the form with the current record

Call PopulateProjectsControls

End If

Exit Sub

HandleError:

GeneralErrorHandler Err.Number, Err.Description, PROJECTS_FORM,"LoadRecords"

Exit Sub

End

Sub

15.

Add the following procedures for dealing with the toggle button allowing the user to switch from unclosed projects to all projects.

Private Sub togShowAll_Click()

Private Sub togShowAll_Click()

On Error GoTo HandleError If togShowAll.Value = True Then blnAllRecords = True

'make sure Show Unclosed is not checked any more togShowUnclosed.Value = False

'now, populate the form with all projects records LoadRecords

End If

Exit Sub

HandleError:

GeneralErrorHandler Err.Number, Err.Description, PROJECTS_FORM, _

"togShowAll_Click" Exit Sub

End Sub

Private Sub togShowUnclosed_Click() On Error GoTo HandleError If togShowUnclosed.Value = True Then blnAllRecords = False

'make sure Show All is not checked any more togShowAll.Value = False

'now, populate the form with all unclosed projects records LoadRecords

End If

Exit Sub

HandleError:

GeneralErrorHandler Err.Number, Err.Description, PROJECTS_FORM, _

"togShowUnclosed_Click" Exit Sub

End Sub

16. Add the following procedures that deal with saving the records displayed on the tabs of the form to the database.

Sub SaveComments()

On Error GoTo HandleError

Dim strSQLStatement As String Dim intId As Integer Dim strComment As String Dim intCounter

'remove all current comments in database for this project strSQLStatement = BuildSQLDeleteProjectsComments(objProjects.ProjectId)

ProcessUpdate (strSQLStatement)

'add back all comments based on current list (easier than tracking 'changes, inserts, and deletes)

For intCounter = 0 To lstComments.ListCount - 1 intId = objProjects.ProjectId strComment = lstComments.Column(0, intCounter)

strSQLStatement = BuildSQLInsertProjectsComments(intId, strComment) ProcessUpdate (strSQLStatement) Next intCounter

Exit Sub

HandleError:

GeneralErrorHandler Err.Number, Err.Description, PROJECTS_FORM, "SaveComments" Exit Sub

End Sub

Sub SaveContacts()

On Error GoTo HandleError

Dim strSQLStatement As String Dim intContId As Integer Dim intProjId As Integer Dim intCounter As Integer

'remove all current contacts in database for this project strSQLStatement = BuildSQLDeleteProjectsContacts(objProjects.ProjectId) ProcessUpdate (strSQLStatement)

'add back all contacts based on current list (easier than tracking 'changes, inserts, and deletes)

For intCounter = 0 To lstContacts.ListCount - 1 intContId = lstContacts.Column(6, intCounter) intProjId = objProjects.ProjectId strSQLStatement = BuildSQLInsertProjectsContacts(intContId, intProjId) ProcessUpdate (strSQLStatement) Next intCounter

Exit Sub

HandleError:

GeneralErrorHandler Err.Number, Err.Description, PROJECTS_FORM, "SaveContacts" Exit Sub

End Sub

Sub SaveAttachments()

On Error GoTo HandleError

Dim strSQLStatement As String Dim intId As Integer Dim strDesc As String Dim strFile As String Dim intCounter As Integer

'remove all current file attachments in database for this project strSQLStatement = BuildSQLDeleteProjectsAttachments(objProjects.ProjectId) ProcessUpdate (strSQLStatement)

'add back all file attachments based on current list (easier than tracking 'changes, inserts, and deletes)

For intCounter = 0 To lstFileAttachments.ListCount - 1 intId = objProjects.ProjectId strDesc = lstFileAttachments.Column(0, intCounter) strFile = lstFileAttachments.Column(1, intCounter)

strSQLStatement = BuildSQLInsertProjectsAttachments(intId, strDesc, _ strFile)

ProcessUpdate (strSQLStatement) Next intCounter

Exit Sub

HandleError:

GeneralErrorHandler Err.Number, Err.Description, PROJECTS_FORM, _

"SaveComments" Exit Sub

End Sub

17. Add the following RefreshContacts procedure to frmProjects. This procedure gets called whenever the user clicks to add the contact to the current project.

Sub RefreshContacts()

On Error GoTo HandleError

'populate the recordset for tab 2 Set rsContacts = New ADODB.Recordset

Set rsContacts = objProjects.RetrieveContacts(objProjects.ProjectId) PopulateListFromRecordset Me.lstContacts, rsContacts, 7 rsContacts.Close

Exit Sub

HandleError:

GeneralErrorHandler Err.Number, Err.Description, PROJECTS_FORM, _

"RefreshContacts" Exit Sub

End Sub

0 0

Post a comment