

'----------------------------------------------------------------
' Please follow the instructions in the book.
' This chapter uses the AssetsDataEntry.mdb database for 
' its Hands-On exercises.
'----------------------------------------------------------------

' ---------------------------------------------------------------
' Hands-On 26-1
' No code.
' Please follow the instructions in the book.
' ---------------------------------------------------------------


' ---------------------------------------------------------------
' Hands-On 26-2
' ---------------------------------------------------------------

Private Sub cboRooms_Enter()
    If Me.cboCompanyID = "" Or IsNull(Me.cboCompanyID) Then
        MsgBox "Please select Company ID.", _
            vbInformation + vbOKOnly, _
            "Missing Company ID"
        Me.cboCompanyID.SetFocus
        Exit Sub
    End If
End Sub


' ---------------------------------------------------------------
' Code on page 627
' ---------------------------------------------------------------

Private Sub cboRoomType_Enter()
    If Me.cboCompanyID = "" Or IsNull(Me.cboCompanyID) Then
        MsgBox "Please select Company ID.", _
            vbInformation + vbOKOnly, "Missing Company ID"
        Me.cboCompanyID.SetFocus
        Exit Sub
    End If
    If Me.cboRooms = "" Or IsNull(Me.cboRooms) Then
        MsgBox "Please specify or select Room number.", _
            vbInformation + vbOKOnly, "Missing Room Number"
        Me.cboRooms.SetFocus
        Exit Sub
    End If
End Sub


' ---------------------------------------------------------------
' Hands-On 26-3
' ---------------------------------------------------------------

Private Sub cboCompanyID_BeforeUpdate(Cancel As Integer)
    Dim strMsg As String, strTitle As String
    Dim intStyle As Integer
    
    If IsNull(Me!cboCompanyID) Or Me!cboCompanyID = "" Then
        strMsg = "You must pick a value from the Company ID list."
        strTitle = "Company ID Required"
        intStyle = vbOKOnly
        MsgBox strMsg, intStyle, strTitle
        Cancel = True
    End If
End Sub


' ---------------------------------------------------------------
' Code on page 628-629
' ---------------------------------------------------------------

Private Sub cboCompanyID_AfterUpdate()
    With Me
        .txtCompanyName = Me.[cboCompanyID].Column(1)
        .txtAddress = Me.cboCompanyID.Column(2)
        .txtCity = Me.cboCompanyID.Column(3)
        .txtRegion = Me.cboCompanyID.Column(4)
        .txtPostalCode = Me.cboCompanyID.Column(5)
        .txtCountry = Me.cboCompanyID.Column(6)
        .cboRooms.Value = vbNullString
        .cboRooms.Requery
        .txtRoomDescription = vbNullString
        .cboRoomType = vbNullString
        .cboOS = vbNullString
        .txtOperatingSystem = vbNullString
        .cboProject = vbNullString
        .txtPID = vbNullString
    End With
    If Me.cboRooms.ListCount = 0 Then
        'do not display column headings
        Me.cboRooms.ColumnHeads = False
    Else
        Me.cboRooms.ColumnHeads = True
    End If
    Me.cboRooms.SetFocus
End Sub


' ---------------------------------------------------------------
' Hands-On 26-4
' No code.
' Please follow the instructions in the book.
' ---------------------------------------------------------------


' ---------------------------------------------------------------
' Code on page 630
' ---------------------------------------------------------------

Private Sub cboRoomType_NotInList(NewData As String, _
    Response As Integer)
    
    MsgBox "Please select a value from the list.", _
    vbInformation + vbOKOnly, "Invalid entry"
    ' Continue without displaying default error message.
    Response = acDataErrContinue
End Sub



' ---------------------------------------------------------------
' Hands-On 26-5
' No code.
' Please follow the instructions in the book.
' ---------------------------------------------------------------


' ---------------------------------------------------------------
' Code on page 631
' ---------------------------------------------------------------

Private Sub cmdNewCompany_Click()
    On Error GoTo Err_cmdNewCompany_Click
    
    Dim stDocName As String
    Dim stLinkCriteria As String
    
    stDocName = "frmAddCompany"
    DoCmd.OpenForm stDocName, , , stLinkCriteria
Exit_cmdNewCompany_Click:
    Exit Sub
Err_cmdNewCompany_Click:
    MsgBox Err.Description
    Resume Exit_cmdNewCompany_Click
End Sub


' ---------------------------------------------------------------
' Code on page 632-633
' ---------------------------------------------------------------

Private Sub cmdSaveCompanyInfo_Click()
    Dim conn As ADODB.Connection
    Dim rst As New ADODB.Recordset
    Dim ctrl As Control
    Dim count As Integer
    
    On Error GoTo Err_cmdSaveCompanyInfo_Click
    
    'validate data prior to save
    
    For Each ctrl In Me.Controls
        If ctrl.ControlType = acTextBox And IsNull(ctrl) _
            Or IsEmpty(ctrl) Then
            count = count + 1
            If count > 0 Then
                MsgBox "All text fields must be filled in.", _
                    vbInformation + vbOKOnly, _
                    "Missing Data"
                ctrl.SetFocus
                Exit Sub
            End If
        End If
    Next
    
    If Len(Me.txtAddCompanyID) <> 5 Then
        MsgBox "There must be 5 characters in the Company ID field."
        Me.txtAddCompanyID.SetFocus
        Exit Sub
    End If
    
    'check the zipcode field
    If Len(Me.txtAddPostalCode) <> 5 And _
        UCase(Me.txtAddCountry) = "USA" Then
            MsgBox "Please enter a five-digit zip code " & _
                "for the United States.", _
                vbInformation + vbOKOnly, "Invalid Zip Code"
        Me.txtAddPostalCode.SetFocus
        Exit Sub
    End If
    
    'are any alphabetic characters in zip code?
    If Not IsNumeric(Me.txtAddPostalCode) And _
        UCase(Me.txtAddCountry) = "USA" Then
            MsgBox "You can't have letters in Zip Code.", _
                vbInformation + vbOKOnly, "Invalid Zip Code"
        Me.txtAddPostalCode.SetFocus
        Exit Sub
    End If
    
    'save the data
    Set conn = CurrentProject.Connection
    
    With rst
        .Open "SELECT * FROM tblCompanies", _
            conn, adOpenKeyset, adLockOptimistic
    
        'check if the CompanyID is not a duplicate
        .Find "CompanyID='" & Me.txtAddCompanyID & "'"
        'if Company already exists then get out
        If Not rst.EOF Then
            MsgBox "This Company is already in the list : " _
                & rst("CompanyID"), _
                vbInformation + vbOKOnly, "Duplicate Company ID"
            Me.txtAddCompanyID.SetFocus
            Exit Sub
        End If
        .AddNew
        !CompanyID = Me.txtAddCompanyID
        !CompanyName = Me.txtAddCompanyName
        !Address = Me.txtAddAddress
        !City = Me.txtAddCity
        !Region = Me.txtAddRegion
        !PostalCode = Me.txtAddPostalCode
        !Country = Me.txtAddCountry
        .Update
        .Close
    End With
    
    Set rst = Nothing
    conn.Close
    Set conn = Nothing
    
    'requery the combo box on the main form
    Forms!frmDataEntryMain.cboCompanyID.Requery
    
    'close the form
    DoCmd.Close
Exit_cmdSaveCompanyInfo_Click:
    Exit Sub
Err_cmdSaveCompanyInfo_Click:
    MsgBox Err.Description
    Resume Exit_cmdSaveCompanyInfo_Click
End Sub


' ---------------------------------------------------------------
' Hands-On 26-6
' ---------------------------------------------------------------

Private Sub cmdRoomInfoSec_Click()
    Dim stDocName As String
    Dim stLinkCriteria As String
    
    On Error GoTo Err_cmdRoomInfoSec_Click
    
    stDocName = "frmHelpMe"
    stLinkCriteria = "HelpId = 2"
    DoCmd.OpenForm stDocName, , , stLinkCriteria
    
Exit_cmdRoomInfoSec_Click:
    Exit Sub
Err_cmdRoomInfoSec_Click:
    MsgBox Err.Description
    Resume Exit_cmdRoomInfoSec_Click
End Sub


' ---------------------------------------------------------------
' Hands-On 26-7
' ---------------------------------------------------------------

Private Sub lboxCategories_DblClick(Cancel As Integer)
    Dim conn As ADODB.Connection
    Dim myAsset As String
    Dim myAssetDesc As String
    Dim Response As String
    Dim strSQL As String
    
    myAsset = Me.lboxCategories.Value
    myAssetDesc = Me.lboxCategories.Column(1)
    
    If myAsset >= 1 And myAsset <= 11 Then
        MsgBox "Cannot Delete - This item is being used.", _
            vbOKOnly + vbCritical, "Asset Type: " & myAsset
        Exit Sub
    End If
    
    If (Not IsNull(DLookup("[AssetType]", "tblProjectDetails", _
        "[AssetType] = " & myAsset))) Or _
            Not IsNull(DLookup("[EquipCategoryID]", "tblEquipInventory", _
            "[EquipCategoryID] = " & myAsset)) Then
        MsgBox "This item cannot be deleted.", _
            vbOKOnly + vbCritical, "Asset Type: " & myAsset
    Else
        Response = MsgBox("Do you want to delete this Asset?", _
            vbYesNo, "Delete - " & myAssetDesc & " ?")
        If Response = 6 Then
            Set conn = CurrentProject.Connection
            strSQL = "DELETE * FROM tblEquipCategories Where EquipCategoryID = "
            conn.Execute (strSQL & myAsset)
            conn.Close
            Set conn = Nothing
            Me.lboxCategories.Requery
        End If
    End If
    DoCmd.Close
    
    ' requery the combo box on the subform
    Forms!frmDataEntryMain.frmSubProjectDetails.Form.EquipCatId.Requery
End Sub

