dHookum:
As promised here is the code for the Detail form:
frmABCDetail
Private Sub cdAddKeyword_Click()
On Error GoTo Err_cdAddKeyword_Click
Dim strCriteria As String, strQueryName As String
Dim gdf As QueryDef
Dim varVar As Variant
strQueryName = "qryJSABCKeywordSubformAdd"
Set gdf = g_dbABC.QueryDefs(strQueryName)
'check for no value in field
If Len(tbAssignAvailableKeyword & "") <> 0 Then
DoCmd.SetWarnings False
varVar = DLookup("[keyword_index]", "tblKeyword", "keyword_name ='" & [tbAssignAvailableKeyword] & "'")
gdf.Parameters("ABC_index") = Me![tbDocIndex]
gdf.Parameters("keywd_name") = Me![tbAssignAvailableKeyword]
gdf.Parameters("keywd_index") = varVar
gdf.Execute (dbFailOnError)
gdf.Close
g_IsChanged = False
DoCmd.SetWarnings True
Me![frmKeywordDetailSecondsubform].Requery
Me.Refresh
Else
MsgBox "No keyword to assign. Please select keyword and try again.", vbOKOnly, "ABC"
End If
Exit_cdAddKeyword_Click:
Exit Sub
Err_cdAddKeyword_Click:
If dbFailOnError = 128 Then
'MsgBox Err.Description
MsgBox "Keyword already exists. Can't add keyword.", vbOKOnly, "ABC"
Resume Exit_cdAddKeyword_Click
Else
MsgBox Err.Description, vbOKOnly, "ABC"
Resume Exit_cdAddKeyword_Click
End If
End Sub
'-------------------------------------------------
' Delete keyword record form temporary table
'-------------------------------------------------
Private Sub cmdDeleteKeyword_Click()
On Error GoTo Err_cmdDeleteKeyword_Click
Dim strCriteria As String, strQueryName As String
Dim gdf As QueryDef
strQueryName = "qryJSABCKeywordSubformDelete"
Set gdf = g_dbABC.QueryDefs(strQueryName)
'check for no value in field
If (Me![frmKeywordDetailSecondsubform].Form.RecordsetClone.RecordCount <> 0) Then
'If Len(Me![frmKeywordDetailSecondsubform].Form!tbKeywordName & "") <> 0 Then
DoCmd.SetWarnings False
gdf.Parameters("ABC_index") = Me![tbDocIndex]
gdf.Parameters("keywd_name") = Me.[frmKeywordDetailSecondsubform].Form!tbKeywordName
gdf.Execute (dbFailOnError)
gdf.Close
g_IsChanged = False
DoCmd.SetWarnings True
Me![frmKeywordDetailSecondsubform].Form.Requery
Me![frmKeywordDetailSecondsubform].Form.RecordsetClone.AbsolutePosition = 0
Me![frmKeywordDetailSecondsubform].Form.Repaint
Else
MsgBox "No keyword to delete.", vbOKOnly, "ABC"
End If
Exit_cmdDeleteKeyword_Click:
Exit Sub
Err_cmdDeleteKeyword_Click:
If (Err = 2427) Then
MsgBox "No data to delete. Please try again.", 0, "ABC"
Else
If Err = 3021 Then ' No current record
Resume Exit_cmdDeleteKeyword_Click
Else
MsgBox Err.Description, vbOKOnly, "ABC"
End If
End If
Resume Exit_cmdDeleteKeyword_Click
Exit Sub
End Sub
Private Sub cmdAddReview_Click()
'On Error GoTo Err_cmdAddReview
Dim strCriteria As String, strQueryName As String
Dim gdf As QueryDef
Dim g_strClear, varExists As Variant
g_strClear = ""
If Len(Me![tbDateCreated] & "") = 0 Then
Me![tbDateCreated] = Format(Date, "mm/dd/yyyy")
End If
'check for existing record
If ReviewChecks Then
varExists = DLookup("[doc_index]", "tblJSABCReviewTemporary", "[rvw_created_date] = #" & Me![tbDateCreated] & "# And [doc_index] = " & Me![tbDocIndex])
If varExists Then
If CheckReviewChange Then 'if changed save record, else do nothing
'"Save current review record first?"
If MsgBox("A record exists for the date: " & Format(Me![tbDateCreated], "mm/dd/yyyy") & " . Do you wish to save changes?", vbYesNo, "ABC") = vbYes Then
'update
'Me![Reviews].SetFocus
strQueryName = "qryJSABCReviewSubformListUpdate"
Set gdf = g_dbABC.QueryDefs(strQueryName)
gdf.Parameters("inpdoc_index") = Me![tbDocIndex]
gdf.Parameters("inpdate_created") = Nz(Me![tbDateCreated])
gdf.Parameters("inpaction_number") = Nz(Me![tbActionNumber])
gdf.Parameters("inpaction_officer") = Me![tbReviewerAO]
If IsNull(Me![tbAOPhone]) Then
Me![tbAOPhone] = ""
End If
gdf.Parameters("inpao_phone") = Nz(Me![tbAOPhone])
If IsNull(Me![tbReviewCompleted]) Then
Me![tbReviewCompleted] = ""
End If
gdf.Parameters("inprvw_completed_date") = Me![tbReviewCompleted]
gdf.Parameters("inprvw_status_code") = Me![cb2Status]
gdf.Parameters("inprvw_suspense") = Nz(Me![tbSuspenseDate])
gdf.Parameters("inprvw_tasked_date") = Me![tbTaskedDate]
gdf.Parameters("inprvw_type_code") = Me![cbReviewType]
gdf.Execute (dbFailOnError)
gdf.Close
g_IsChanged = False
End If
End If
'clear fields
Me![tbDateCreated] = g_strClear
Me![tbTaskedDate] = g_strClear
Me![cbReviewType] = g_strClear
Me![tbActionNumber] = g_strClear
Me![tbSuspenseDate] = g_strClear
Me![tbReviewCompleted] = g_strClear
Me![cb2Status] = g_strClear
Me![tbReviewerAO] = g_strClear
Me![tbAOPhone] = g_strClear
g_strSaveFlag = True 'review save button set to true
Me![tbActionNumber].SetFocus
Else
'add
Me!Reviews.SetFocus
strQueryName = "qryJSABCReviewSubformAdd"
Set gdf = g_dbABC.QueryDefs(strQueryName)
'check for no value in field
DoCmd.SetWarnings False
'add record
gdf.Parameters("inpdoc_index") = Me![tbDocIndex]
gdf.Parameters("inprvw_created_date") = Me![tbDateCreated]
gdf.Parameters("inpaction_number") = Me![tbActionNumber]
gdf.Parameters("inpaction_officer") = Me![tbReviewerAO]
gdf.Parameters("inpao_phone") = Me![tbAOPhone]
gdf.Parameters("inprvw_completed_date") = Me![tbReviewCompleted]
gdf.Parameters("inprvw_status_code") = Me![cb2Status]
gdf.Parameters("inprvw_suspense") = Me![tbSuspenseDate]
gdf.Parameters("inprvw_tasked_date") = Me![tbTaskedDate]
gdf.Parameters("inprvw_type_code") = Me![cbReviewType]
gdf.Execute (dbFailOnError)
gdf.Close
g_IsChanged = False
DoCmd.SetWarnings True
strSaveFlag = True 'review save button set to true
End If
If TabPage.Value <> ExitTab Then
Me![frmJSABCReviewSubform].Requery
'Forms![frmJSABCDetail].Requery
End If
End If
Exit_cmdAddReview:
Exit Sub
Err_cmdAddReview:
If dbFailOnError = 128 Then
MsgBox Err.Description, vbOKOnly, "ABC"
Resume Exit_cmdAddReview
Else
MsgBox Err.Description, vbOKOnly, "ABC"
Resume Exit_cmdAddReview
End If
End Sub
'------------------------------------------------------------------------------
Private Sub cmdDelReview_Click()
On Error GoTo Err_cmdDelReviewClick
On Error GoTo Err_cmdDeleteReviewClick
Dim strCriteria As String, strQueryName As String
Dim gdf As QueryDef
strQueryName = "qryJSABCReviewSubformDelete"
Set gdf = g_dbABC.QueryDefs(strQueryName)
'check for no value in field
DoCmd.SetWarnings False
gdf.Parameters("ABC_index") = Me![frmJSABCReviewSubform].Form!doc_index
gdf.Parameters("created_date") = Me![tbDateCreated]
gdf.Execute (dbFailOnError)
gdf.Close
g_IsChanged = False
DoCmd.SetWarnings True
'Me![frmJSABCReviewSubform].Requery
'tbTaskedDate = g_strClear
Me![frmJSABCReviewSubform].Requery
Me![frmJSABCReviewRemarkSubform].Requery
Me.Requery
Exit_cmdDeleteReviewClick:
Exit Sub
Err_cmdDeleteReviewClick:
If (Err = 2427) Then
MsgBox "No Review data to delete. Please try again.", 0, "ABC"
Else
MsgBox Err.Description, vbOKOnly, "ABC"
'MsgBox "Error on delete ReviewRemark", vbOKOnly, "ABC"
End If
Resume Exit_cmdDeleteReviewClick
Exit Sub
Exit_cmdDelReviewClick:
Exit Sub
Err_cmdDelReviewClick:
MsgBox Err.Description, vbOKOnly, "ABC"
Resume Exit_cmdDelReviewClick
End Sub
'------------------------------------------------------------------------------
Private Function UpdateReviewRemarks()
Dim strCriteriaReviewRemarks
Dim qdf As QueryDef
On Error GoTo Err_UpdateReviewRemarks
UpdateReviewRemarks = False
DoCmd.SetWarnings False
'---Update ReviewRemarks Table
'---If no temp-ReviewRemark data, delete from permanent-ReviewRemark table only
' If Len(Me![frmJSABCReviewRemarkSubform]![ReviewRemark_date] & "") <> 0 Then
If Len(Me![tbDocIndex] & "") <> 0 Then
' DoCmd.SetWarnings True
strCriteriaReviewRemarks = "Delete * from tblReview_Remark where doc_index = " & Me![tbDocIndex]
DoCmd.RunSQL strCriteriaReviewRemarks
'End If
'-update ReviewRemark with temp ReviewRemark table
DoCmd.OpenQuery ("qryJSABCReviewRemarkSubformUpdate")
'MsgBox "no ReviewRemark data to update"
'-delele ReviewRemark data
Else
MsgBox "no doc index, no reveiw remarks", 0, "ABC"
End If
DoCmd.SetWarnings True
UpdateReviewRemarks = True
Exit_UpdateReviewRemarks:
Exit Function
Err_UpdateReviewRemarks:
MsgBox "Update ReviewRemarks: " & Err.Description, vbOKOnly, "ABC"
Resume Exit_UpdateReviewRemarks
End Function
'------------------------------------------------------------------------------
Private Sub tbActionNumber_BeforeUpdate(Cancel As Integer)
If Len(tbActionNumber & "") <> 0 Then
If (CheckLength(Len([tbActionNumber]), 15)) = False Then
Cancel = True
End If
End If
End Sub
'------------------------------------------------------------------------------
Private Sub tbAOPhone_BeforeUpdate(Cancel As Integer)
If Len(tbAOPhone & "") <> 0 Then
If (CheckLength(Len([tbAOPhone]), 8)) = False Then
Cancel = True
End If
End If
End Sub
Private Sub tbAssignAvailableKeyword_Change()
Call adhIncSearch(Me!tbAssignAvailableKeyword, Me!lbAvailableKeyword, "keyword_name")
Me.tbAssignedKeywordIndex = Me.lbAvailableKeyword.Column(1)
End Sub
Private Sub tbAssignAvailableKeyword_Enter()
Call adhIncSearch(Me!tbAssignAvailableKeyword, Me!lbAvailableKeyword, "keyword_name")
Me.tbAssignedKeywordIndex = Me.lbAvailableKeyword.Column(1)
End Sub
Private Sub tbAssignAvailableKeyword_Exit(Cancel As Integer)
Call adhUpdateSearch(Me!tbAssignAvailableKeyword, Me!lbAvailableKeyword)
Me.tbAssignedKeywordIndex = Me.lbAvailableKeyword.Column(1)
End Sub
'------------------------------------------------------------------------------
Private Sub tbAvailable_BeforeUpdate(Cancel As Integer)
If Len(tbAvailable & "") <> 0 Then
If (CheckLength(Len([tbAvailable]), 20)) = False Then
Cancel = True
End If
End If
End Sub
'------------------------------------------------------------------------------
Private Sub tbCancellationDate_BeforeUpdate(Cancel As Integer)
' Convert InDate to a date variable and check to see if it's valid
Cancel = True
If (Len(Me![tbCancellationDate] & "") > 0) Then 'something type in
If IsNumeric(Right(Format(Me![tbCancellationDate], "mm/dd/yyyy"), 4)) Then
If IsDate(Me![tbCancellationDate]) Then
Cancel = False
Else
MsgBox "Please enter a valid date? Ex: mm/dd/yyyy", vbOKOnly, "ABC"
End If
Else
MsgBox "Please enter a valid date? Ex: mm/dd/yyyy", vbOKOnly, "ABC"
End If
Else
Cancel = False
End If
End Sub
'------------------------------------------------------------------------------
Private Sub tbCmdDist_BeforeUpdate(Cancel As Integer)
If Len(tbCmdDist & "") <> 0 Then
If (CheckLength(Len([tbCmdDist]), 15)) = False Then
Cancel = True
End If
End If
End Sub
'------------------------------------------------------------------------------
Private Sub tbDateCreated_BeforeUpdate(Cancel As Integer)
'If tbDateCreated = "" Then
'Forms![frmJSABCDetail]![frmJSABCReviewRemarkSubform].Visible = False
'Me.cmdAddReviewRemarks.Visible = False
'Me.cmdDeleteReviewRemarks.Visible = True
'End If
End Sub
'------------------------------------------------------------------------------
Public Function ReviewChecks()
'If TabPage.Value = ReviewTab Then
ReviewChecks = False
If Len([cb2Status] & "") = 0 Then
MsgBox "Status must be entered. Please try again", vbOKOnly, "ABC"
[cb2Status].SetFocus
Exit Function
End If
If Len([cbReviewType] & "") = 0 Then
MsgBox "Review Type must be entered. Please try again", vbOKOnly, "ABC"
[cbReviewType].SetFocus
Exit Function
End If
ReviewChecks = True
'Else
'TabPage_Change
'End If
End Function
'------------------------------------------------------------------------------
Public Function DeleteForm()
Dim MyRecordsABC, MyRecordsKeyword, MyRecordsReview As Recordset
Dim varExists As Variant
On Error GoTo Err_DeleteForm
DeleteForm = False
If MsgBox("Do you really want to delete?", vbYesNo, "ABC") = vbYes Then
g_wrkABC.BeginTrans
If (DeleteDetail("qryABCDetailDelete")) Then
g_wrkABC.CommitTrans
DeleteForm = True
Forms![frmJSABCList].Requery
Else
g_wrkABC.Rollback
End If
Else
Exit Function
End If
Exit_DeleteForm:
Exit Function
Err_DeleteForm:
MsgBox Err.Description, vbOKOnly, "ABC"
Resume Exit_DeleteForm
End Function
'---------------------------------------------------------------
Private Function DeleteDetail(strQueryName) As Integer
'---------------------------------------------------------------
Dim intAnswer As Integer
On Error GoTo Err_DeleteDetail
Dim varExists As Variant
Dim qdf As QueryDef
DeleteDetail = False
'Test for corresponding prescr_doc_index in the Form table before deleting
'varExists = DLookup("[doc_index]", "tblForm", "[prescr_doc_index] =" & Me![tbDocIndex])
' [tbReviewStatus] = DLookup("[rvw_status_code]", "tblJSABCReviewTemporary", "[rvw_created_date] = #" & varExists & "#")
'If varExists Then
' MsgBox "Can't delete. The form ABC number :" & varExists & " must be deleted first."
' Exit Function
'End If
Set qdf = g_dbABC.QueryDefs(strQueryName)
qdf.Parameters("inpdoc_index") = Me![tbDocIndex]
qdf.Execute (dbFailOnError)
DeleteDetail = True
Exit_DeleteDetail:
If Not qdf Is Nothing Then qdf.Close
Exit Function
Err_DeleteDetail:
MsgBox "DeleteQuery: " & Err.Description, vbOKOnly, "ABC"
Resume Exit_DeleteDetail
End Function
'------------------------------------------------------------------------------
Public Function LoadAddForm()
'unlock date and number
Me![tbDocIndex] = 999
Me![tbABCNumber].BackColor = WHITE
Me![tbABCNumber].Enabled = True
Me![tbABCNumber].Locked = False
Me![tbABCDate].BackColor = WHITE
Me![tbABCDate].Enabled = True
Me![tbABCDate].Locked = False
'Me![tbABCDate] = ""
Me![tbCancellationDate].BackColor = GRAY
Me![tbCancellationDate].Enabled = False
Me![tbCancellationDate].Locked = True
Me![tbABCNumberAssigned].BackColor = GRAY
Me![tbABCNumberAssigned] = Format(Date, "mm/dd/yyyy") 'set to today's date
Me![tbABCNumberAssigned].Enabled = False
Me![tbABCNumberAssigned].Locked = True
'hide review tab
Me![Reviews].Visible = False
'un hide keyword tab and change tab
Me![Keywords].Visible = True
[cdAddChange].Enabled = True
[cdDeleteChange].Enabled = True
g_strDateCreated = g_strClear
g_strTaskedDate = g_strClear
g_strReviewType = g_strClear
g_strActionNumber = g_strClear
g_strSuspenseDate = g_strClear
g_strReviewCompleted = g_strClear
g_str2Status = g_strClear
g_strReviewerAO = g_strClear
g_strAOPhone = g_strClear
End Function
'------------------------------------------------------------------------------
Public Function MyDate(InDate)
' Convert InDate to a date variable and check to see if it's valid
If IsDate(InDate) Then
MyDate = CDate(InDate)
Exit Function
Else
MsgBox "Value entered is not a date. Please try again.", vbOKOnly + vbExclamation, "ABC"
End If
End Function
'------------------------------------------------------------------------------
Private Sub tbABCDate_AfterUpdate()
If OpenArgs = "Add" Then
GetNextReviewDate
End If
Me.tbABCDate.Locked = True
'Me.tbABCDate.Enabled = False
Me.tbABCDate.BackColor = GRAY
End Sub
'------------------------------------------------------------------------------
Private Sub tbABCDate_BeforeUpdate(Cancel As Integer)
' Convert InDate to a date variable and check to see if it's valid
Cancel = True
If (Len(Me![tbABCDate] & "") > 0) Then 'something type in
If IsNumeric(Right(Format(Me![tbABCDate], "mm/dd/yyyy"), 4)) Then
If IsDate(Me![tbABCDate]) Then
Cancel = False
Else
MsgBox "Please enter a valid date? Ex: mm/dd/yyyy", vbOKOnly, "ABC"
End If
Else
MsgBox "Please enter a valid date? Ex: mm/dd/yyyy", vbOKOnly, "ABC"
End If
Else
Cancel = False
End If
End Sub
'------------------------------------------------------------------------------
Private Sub tbABCNumber_BeforeUpdate(Cancel As Integer)
If Len(tbABCNumber & "") <> 0 Then
If (CheckLength(Len([tbABCNumber]), 16)) = False Then
Cancel = True
End If
End If
End Sub
'------------------------------------------------------------------------------
Private Sub tbFileLocation_BeforeUpdate(Cancel As Integer)
If Len(tbFileLocation & "") <> 0 Then
If (CheckLength(Len([tbFileLocation]), 20)) = False Then
Cancel = True
End If
End If
End Sub
'------------------------------------------------------------------------------
Private Sub tbFiscalYear_BeforeUpdate(Cancel As Integer)
'If (IsNumeric(Left([tbFiscalYear], 4)) And (Left([tbFiscalYear], 4) > 1900)) Then
' If Mid([tbFiscalYear], 5, 1) = "-" Then
' If (IsNumeric(Right([tbFiscalYear], 4)) And (Right([tbFiscalYear], 4) > 1900)) Then
' Exit Sub
' End If
'End If
'nd If
' MsgBox "Enter a Fiscal Year in the format of YYYY-YYYY, where YYYY greater than 1900.", vbOKOnly, "ABC"
'[tbFiscalYear].SetFocus
'If IsNumeric(tbFiscalYear) Then
'If (tbFiscalYear > 1900) Then
If Len(tbFiscalYear & "") <> 0 Then
If (CheckLength(Len([tbFiscalYear]), 9)) = False Then
Cancel = True
End If
End If
'Else
' MsgBox "Enter a Fiscal Year in the format of YYYY.", vbOKOnly, "ABC"
'End If
' Else
' MsgBox "Enter a Fiscal Year in the format of YYYY.", vbOKOnly, "ABC"
'End If
End Sub
'------------------------------------------------------------------------------
Private Sub tbInactiveReason_BeforeUpdate(Cancel As Integer)
If Len(tbInactiveReason & "") <> 0 Then
If (CheckLength(Len([tbInactiveReason]), 45)) = False Then
Cancel = True
End If
End If
End Sub
Private Sub tbNextReviewDate_AfterUpdate()
'If OpenArgs = "Add" Then
' GetNextReviewDate
'End If
End Sub
Private Sub tbNextReviewDate_BeforeUpdate(Cancel As Integer)
Cancel = True
If (Len(Me![tbNextReviewDate] & "") > 0) Then 'something type in
If IsNumeric(Right(Format(Me![tbNextReviewDate], "mm/dd/yyyy"), 4)) Then
If IsDate(Me![tbNextReviewDate]) Then
Cancel = False
Else
MsgBox "Please enter a valid date? Ex: mm/dd/yyyy", vbOKOnly, "ABC"
End If
Else
MsgBox "Please enter a valid date? Ex: mm/dd/yyyy", vbOKOnly, "ABC"
End If
Else
Cancel = False
End If
End Sub
'------------------------------------------------------------------------------
Private Sub tbNumberOfPages_BeforeUpdate(Cancel As Integer)
On Error GoTo tbError
If Len(tbNumberOfPages & "") <> 0 Then
If IsNumeric(tbNumberOfPages) Then
If [tbNumberOfPages] > 0 And [tbNumberOfPages] < 32768 Then
Exit Sub
Else
Cancel = True
MsgBox "Number must be greater than 0 or less 32768. Please try again", 0, "ABC"
End If
'If (CheckLength(Len([tbNumberOfPages]), 7)) = False Then
' Cancel = True
'Else
'If [tbNumberOfPages] = 0 Then
'MsgBox "Number must be greater than 0. Please try again", 0, "ABC"
'Cancel = True
'End If
'End If
Else
MsgBox "A number must be entered. Please try again.", vbOKOnly, "ABC"
Cancel = True
End If
End If
tbExit:
Exit Sub
tbError:
MsgBox Err.Description, vbOKOnly, "ABC"
GoTo tbExit
End Sub
'------------------------------------------------------------------------------
Private Sub tbOriginalAO_BeforeUpdate(Cancel As Integer)
If Len(tbOriginalAO & "") <> 0 Then
If (CheckLength(Len([tbOriginalAO]), 25)) = False Then
Cancel = True
End If
End If
End Sub
'------------------------------------------------------------------------------
Private Sub tbReviewCompleted_BeforeUpdate(Cancel As Integer)
' Convert InDate to a date variable and check to see if it's valid
Dim varDate As String
' Convert InDate to a date variable and check to see if it's valid
Cancel = True
If (Len(Me![tbReviewCompleted] & "") > 0) Then 'something type in
If IsNumeric(Right(Format(Me![tbReviewCompleted], "mm/dd/yyyy"), 4)) Then
If IsDate(Me![tbReviewCompleted]) Then
Cancel = False
Else
MsgBox "Please enter a valid date? Ex: mm/dd/yyyy", vbOKOnly, "ABC"
End If
Else
MsgBox "Please enter a valid date? Ex: mm/dd/yyyy", vbOKOnly, "ABC"
End If
Else
Cancel = False
End If
End Sub
'------------------------------------------------------------------------------
Private Sub tbReviewerAO_BeforeUpdate(Cancel As Integer)
If Len(tbReviewerAO & "") <> 0 Then
If (CheckLength(Len([tbReviewerAO]), 25)) = False Then
Cancel = True
End If
End If
End Sub
'------------------------------------------------------------------------------
Private Sub tbShortTitle_BeforeUpdate(Cancel As Integer)
If Len(tbShortTitle & "") <> 0 Then
If (CheckLength(Len([tbShortTitle]), 90)) = False Then
Cancel = True
End If
End If
End Sub
'------------------------------------------------------------------------------
Private Sub tbSpecialTag_BeforeUpdate(Cancel As Integer)
If Len(tbSpecialTag & "") <> 0 Then
If (CheckLength(Len([tbSpecialTag]), 1)) = False Then
Cancel = True
End If
End If
End Sub
'------------------------------------------------------------------------------
Private Sub tbSpecialTagRemark_BeforeUpdate(Cancel As Integer)
If Len(tbSpecialTagRemark & "") <> 0 Then
If (CheckLength(Len([tbSpecialTagRemark]), 30)) = False Then
Cancel = True
End If
End If
End Sub
'------------------------------------------------------------------------------
Private Sub tbSuspenseDate_BeforeUpdate(Cancel As Integer)
' Convert InDate to a date variable and check to see if it's valid
Dim varDate As String
'varDate = Me![tbSuspenseDate]
If (Len(Me![tbSuspenseDate]) > 0) Then 'something type in
If IsNumeric(Right(Format(Me![tbSuspenseDate], "mm/dd/yyyy"), 4)) Then
If IsDate(Me![tbSuspenseDate]) Then
Cancel = False
Else
MsgBox "Please enter a valid date? Ex: mm/dd/yyyy", vbOKOnly, "ABC"
End If
Else
MsgBox "Please enter a valid date? Ex: mm/dd/yyyy", vbOKOnly, "ABC"
End If
End If
End Sub
'------------------------------------------------------------------------------
Private Sub tbSystem_BeforeUpdate(Cancel As Integer)
If Len(tbSystem & "") <> 0 Then
If (CheckLength(Len([tbSystem]), 50)) = False Then
Cancel = True
End If
End If
End Sub
'------------------------------------------------------------------------------
Private Sub tbTaskedDate_BeforeUpdate(Cancel As Integer)
' Convert InDate to a date variable and check to see if it's valid
Dim strDate As String
Cancel = True
'strDate = Nz(Me![tbTaskedDate])
If (Len(Me![tbTaskedDate] & "") > 0) Then 'something type in
If IsNumeric(Right(Format(Me![tbTaskedDate], "mm/dd/yyyy"), 4)) Then
If IsDate(Me![tbTaskedDate]) Then
Cancel = False
Else
MsgBox "Please enter a valid date? Ex: mm/dd/yyyy", vbOKOnly, "ABC"
End If
Else
MsgBox "Please enter a valid date? Ex: mm/dd/yyyy", vbOKOnly, "ABC"
End If
End If
End Sub
Private Sub tbTitle_AfterUpdate()
If Me.OpenArgs = "Add" Then
tbShortTitle = Left(tbTitle, 90)
End If
End Sub
'------------------------------------------------------------------------------
Private Sub tbTitle_BeforeUpdate(Cancel As Integer)
If Len(tbTitle & "") <> 0 Then
If (CheckLength(Len([tbTitle]), 255)) = False Then
Cancel = True
End If
End If
End Sub
'------------------------------------------------------------------------------
Public Function LoadDeleteForm()
Dim MyRecordsABC, MyRecordsKeyword, MyRecordsReview As Recordset
'Dim gdfAdd As QueryDef
Dim varExists As Variant
On Error GoTo Err_LoadDeleteForm
LoadDeleteForm = True
Set MyRecordsABC = g_dbABC.OpenRecordset("qryABCDetail")
With MyRecordsABC
'Link list screen to detail screen on cbABCNumber
If g_strParentFormName = "frmKeywordList" Then
strLinkCriteria = "[doc_index] = " & g_strLinkCriteria
Else
strLinkCriteria = "[Doc_Index] = " & Forms![frmJSABCList]![doc_index]
End If
'strLinkCriteria = "[Doc_Index] = " & Forms![frmJSABCList]![doc_index]
.FindFirst strLinkCriteria
[tbDocIndex] = .Fields("doc_index")
[tbDocIndex].Enabled = False
'[tbDocIndex].BackColor = GRAY
[cbReviewRequired] = .Fields("annual_review_reqd")
[cbReviewRequired].Enabled = False
'[cbReviewRequired].BackColor = GRAY
[tbAvailable] = .Fields("available")
[tbAvailable].Enabled = False
[tbAvailable].Locked = True
[tbAvailable].BackColor = GRAY
[tbABCDate] = .Fields("birth_date")
[tbABCDate].Enabled = False
[tbABCDate].BackColor = GRAY
[tbCancellationDate] = .Fields("cancellation_date")
[tbCancellationDate].Enabled = False
[tbCancellationDate].Locked = True
[tbCancellationDate].BackColor = GRAY
[tbABCNumberAssigned] = .Fields("doc_num_assn_date")
[tbABCNumberAssigned].Enabled = False
[tbABCNumberAssigned].BackColor = GRAY
[tbABCNumber] = .Fields("doc_number")
[tbABCNumber].Enabled = False
[tbABCNumber].BackColor = GRAY
[cbStatus] = .Fields("doc_status_code")
[cbStatus].Enabled = False
[cbStatus].Locked = True
[cbStatus].BackColor = GRAY
[cbSubType] = .Fields("doc_subtype_code")
[cbSubType].Enabled = False
[cbSubType].Locked = True
[cbSubType].BackColor = GRAY
[cbType] = .Fields("doc_type_code")
[cbType].Enabled = False
[cbType].Locked = True
[cbType].BackColor = GRAY
[tbFileLocation] = .Fields("file_location")
[tbFileLocation].Enabled = False
[tbFileLocation].Locked = True
[tbFileLocation].BackColor = GRAY
[tbInactiveReason] = .Fields("inactive_reason")
[tbInactiveReason].Enabled = False
[tbInactiveReason].Locked = True
[tbInactiveReason].BackColor = GRAY
[tbNextReviewDate] = .Fields("next_review_date")
[tbNextReviewDate].Enabled = False
[tbNextReviewDate].Locked = True
[tbNextReviewDate].BackColor = GRAY
[cbOprAgency] = .Fields("opr_agency_code")
[cbOprAgency].Enabled = False
[cbOprAgency].Locked = True
[cbOprAgency].BackColor = GRAY
[tbOriginalAO] = .Fields("original_ao")
[tbOriginalAO].Enabled = False
[tbOriginalAO].Locked = True
[tbOriginalAO].BackColor = GRAY
[cbSecurityClass] = .Fields("sec_class_code")
[cbSecurityClass].Enabled = False
[cbSecurityClass].Locked = True
[cbSecurityClass].BackColor = GRAY
'.Fields ("special_tag")
Select Case (.Fields("stocked_char"))
Case "Y": [OpgrpStocked].Value = 1
Case "N": [OpgrpStocked].Value = 2
Case "R": [OpgrpStocked].Value = 3
End Select
[OpgrpStocked].Enabled = False
[OpgrpStocked].Locked = True
[OpgrpStocked].BackColor = GRAY
[cbInternetApproved] = .Fields("internet_approved")
[cbInternetApproved].Enabled = False
[cbInternetApproved].Locked = True
[cbInternetApproved].BackColor = GRAY
[tbTitle] = .Fields("title")
[tbTitle].Enabled = False
[tbTitle].Locked = True
[tbTitle].BackColor = GRAY
[tbShortTitle] = .Fields("keywd_index")
[tbShortTitle].Enabled = False
[tbShortTitle].Locked = True
[tbShortTitle].BackColor = GRAY
[tbCmdDist] = .Fields("cmd_distribution")
[tbCmdDist].Enabled = False
[tbCmdDist].Locked = True
[tbCmdDist].BackColor = GRAY
[tbFiscalYear] = .Fields("fiscal_year")
[tbFiscalYear].Enabled = False
[tbFiscalYear].Locked = True
[tbFiscalYear].BackColor = GRAY
[tbNumberOfPages] = .Fields("num_pages")
[tbNumberOfPages].Enabled = False
[tbNumberOfPages].Locked = True
[tbNumberOfPages].BackColor = GRAY
[tbSpecialTag] = .Fields("special_tag")
[tbSpecialTag].Enabled = False
[tbSpecialTag].Locked = True
[tbSpecialTag].BackColor = GRAY
[tbSpecialTagRemark] = .Fields("special_tag_rmk")
[tbSpecialTagRemark].Enabled = False
[tbSpecialTagRemark].Locked = True
[tbSpecialTagRemark].BackColor = GRAY
[tbSystem] = .Fields("system_char")
[tbSystem].Enabled = False
[tbSystem].Locked = True
[tbSystem].BackColor = GRAY
[cdAddChange].Enabled = False
[cdDeleteChange].Enabled = False
[cdAddKeyword].Enabled = False
[cmdDeleteKeyword].Enabled = False
[tbAssignAvailableKeyword].Enabled = False
[tbAssignAvailableKeyword].Locked = True
[tbAssignAvailableKeyword].BackColor = GRAY
[tbTaskedDate].Enabled = False
[tbTaskedDate].Locked = True
[tbTaskedDate].BackColor = GRAY
[tbReviewCompleted].Enabled = False
[tbReviewCompleted].Locked = True
[tbReviewCompleted].BackColor = GRAY
[cbReviewType].Enabled = False
[cbReviewType].Locked = True
[cbReviewType].BackColor = GRAY
[tbActionNumber].Enabled = False
[tbActionNumber].Locked = True
[tbActionNumber].BackColor = GRAY
[tbSuspenseDate].Enabled = False
[tbSuspenseDate].Locked = True
[tbSuspenseDate].BackColor = GRAY
[cb2Status].Enabled = False
[cb2Status].Locked = True
[cb2Status].BackColor = GRAY
[tbReviewerAO].Enabled = False
[tbReviewerAO].Locked = True
[tbReviewerAO].BackColor = GRAY
[tbAOPhone].Enabled = False
[tbAOPhone].BackColor = GRAY
[tbAOPhone].Locked = True
[cmdAddReview].Enabled = False
[cmdDelReview].Enabled = False
[cmdAddReviewRemarks].Enabled = False
[cmdDeleteReviewRemarks].Enabled = False
'[cmdDeleteReviewRemarks].Locked = True
Me.frmJSABCReviewRemarkAddSubform.Locked = True
Me.frmJSABCChangeSubform.Locked = True
Me.frmJSABCReviewRemarkAddSubform.Locked = True
Me.frmJSABCReviewRemarkSubform.Locked = True
'Me.lbAvailableKeyword.Locked = True
Me.lbAvailableKeyword.Enabled = False
.Close
End With
Me![Reviews].Visible = True
Me![Keywords].Visible = True
[cdAddChange].Enabled = False
[cdDeleteChange].Enabled = False
'-Load keyword data
DoCmd.SetWarnings False
DoCmd.OpenQuery "qryJSABCKeywordSubformTemporary"
'Run append query to load data into table tblJSABCChangeTemporary
'-Load change data
'DoCmd.SetWarnings True
DoCmd.OpenQuery "qryJSABCChangeSubformTemporary"
'DoCmd.SetWarnings False
'Run append query to load data into table tblJSABCReviewTemporary
'-Load Review data
DoCmd.OpenQuery "qryJSABCReviewSubformTemporary"
'-Note: Review Remark data is load on the Review subform
'Run append query to load data into table tblJSABCReviewRemarkTemporary
'-Load Review data
DoCmd.OpenQuery "qryJSABCReviewRemarkSubformTemporary"
DoCmd.SetWarnings True
'save old values
g_strDateCreated = g_strClear
g_strTaskedDate = g_strClear
g_strReviewType = g_strClear
g_strActionNumber = g_strClear
g_strSuspenseDate = g_strClear
g_strReviewCompleted = g_strClear
g_str2Status = g_strClear
g_strReviewerAO = g_strClear
g_strAOPhone = g_strClear
Exit_LoadDeleteForm:
Exit Function
Err_LoadDeleteForm:
MsgBox Err.Description, vbOKOnly, "ABC"
Resume Exit_LoadDeleteForm
End Function
'------------------------------------------------------------------------------
Private Function InitVars()
InitVars = False
[cbReviewRequired] = 0
[tbAvailable] = ""
[tbABCDate] = ""
[tbCancellationDate] = ""
[tbABCNumberAssigned] = ""
[tbABCNumber] = ""
[cbStatus] = ""
[cbSubType] = ""
[cbType] = ""
[tbFileLocation] = ""
[tbInactiveReason] = ""
[tbNextReviewDate] = ""
[cbOprAgency] = ""
[tbOriginalAO] = ""
[cbSecurityClass] = ""
[cbInternetApproved] = ""
[tbTitle] = ""
[tbShortTitle] = ""
[tbCmdDist] = ""
[tbFiscalYear] = ""
[tbNumberOfPages] = ""
[tbSpecialTag] = ""
[tbSpecialTagRemark] = ""
[tbTaskedDate] = ""
[cbReviewType] = ""
[tbActionNumber] = ""
[tbSuspenseDate] = ""
[tbReviewCompleted] = ""
[cb2Status] = ""
[tbReviewerAO] = ""
[tbSystem] = ""
[tbAOPhone] = ""
'strReviewFlag = True
InitVars = True
End Function
'------------------------------------------------------------------------------
Public Function AddJSABC()
Dim gdfAdd As QueryDef
Dim gdfAddJs As QueryDef
Dim varExists As Variant
On Error GoTo Err_AddABC
AddJSABC = False
g_wrkABC.BeginTrans
Set gdfAdd = g_dbABC.QueryDefs("qryABCDetailAdd")
Set gdfAddJs = g_dbABC.QueryDefs("qryABCDetailAddJS")
' --Add JSABC Table
gdfAdd.Parameters("inpannual_review_reqd") = Me![cbReviewRequired]
gdfAdd.Parameters("inpavailable") = [tbAvailable]
' update only if not locked
If [tbABCDate].Enabled Then
gdfAdd.Parameters("inpbirth_date") = [tbABCDate]
End If
gdfAdd.Parameters("inpcancellation_date") = [tbCancellationDate]
gdfAdd.Parameters("inpdoc_num_assn_date") = [tbABCNumberAssigned]
gdfAdd.Parameters("inpdoc_number") = [tbABCNumber]
gdfAdd.Parameters("inpdoc_status_code") = [cbStatus]
gdfAdd.Parameters("inpdoc_subtype_code") = [cbSubType]
gdfAdd.Parameters("inpdoc_type_code") = [cbType]
gdfAdd.Parameters("inpfile_location") = [tbFileLocation]
gdfAdd.Parameters("inpinactive_reason") = [tbInactiveReason]
gdfAdd.Parameters("inpnext_review_date") = [tbNextReviewDate]
gdfAdd.Parameters("inpopr_agency_code") = [cbOprAgency]
gdfAdd.Parameters("inporiginal_ao") = [tbOriginalAO]
gdfAdd.Parameters("inpsec_class_code") = [cbSecurityClass]
Select Case ([OpgrpStocked].Value)
Case "1": gdfAdd.Parameters("inpstocked_char") = "Y"
Case "2": gdfAdd.Parameters("inpstocked_char") = "N"
Case "3": gdfAdd.Parameters("inpstocked_char") = "R"
End Select
gdfAdd.Parameters("inpinternet_approved") = [cbInternetApproved]
gdfAdd.Parameters("inpspecial_tag") = [tbSpecialTag]
gdfAdd.Parameters("inpspecial_tag_rmk") = [tbSpecialTagRemark]
gdfAdd.Parameters("inptitle") = [tbTitle]
gdfAdd.Parameters("inpdockeywd_index") = [tbShortTitle]
gdfAdd.Parameters("inpis_form") = False 'set field to false
'find last number
gdfAdd.Execute (dbFailOnError)
g_wrkABC.CommitTrans
g_wrkABC.BeginTrans
varExists = DMax("[doc_index]", "tblABC")
Set gdfAddJs = g_dbABC.QueryDefs("qryABCDetailAddJS")
If Not IsNull(varExists) Then
'varExists = varExists + 1
gdfAddJs.Parameters("inpdoc_index") = varExists
End If
gdfAddJs.Parameters("inpcmd_distribution") = [tbCmdDist]
gdfAddJs.Parameters("inpfiscal_year") = [tbFiscalYear]
gdfAddJs.Parameters("inpnum_pages") = [tbNumberOfPages]
gdfAddJs.Parameters("inpsystem_char") = [tbSystem]
gdfAddJs.Execute (dbFailOnError)
g_wrkABC.CommitTrans
'place ABC index value on form to be used in keyword query
Me![tbDocIndex] = varExists
strLinkCriteria = "Update tblJSABCDetailTemporary set doc_index = '" & varExists & "'"
g_dbABC.Execute strLinkCriteria
strLinkCriteria = "Update tblJSABCChangeTemporary set doc_index = '" & varExists & "'"
g_dbABC.Execute strLinkCriteria
strLinkCriteria = varExists
gdfAddJs.Close
gdfAdd.Close
AddJSABC = True
Exit_AddABC:
If Not gdfAdd Is Nothing Then gdfAdd.Close
If Not gdfAddJs Is Nothing Then gdfAddJs.Close
Exit Function
Err_AddABC:
g_wrkABC.Rollback
MsgBox "Add JSABC: " & Err.Description
Resume Exit_AddABC
End Function
Private Function CheckABCNumberDate()
Dim MyRecordsABC, MyRecordsKeyword, MyRecordsReview As Recordset
Dim varExists As Variant
Dim varDocExists As Variant
Dim qdf As QueryDef
Dim strQueryName As String
On Error GoTo Err_ABCAdd
CheckABCNumberDate = False
If Me.OpenArgs = "Modify" Then
If IsNull(Me![tbABCDate]) Or Me![tbABCDate] = "" Then
Me!Check = "N"
Else
Me!Check = "Y"
End If
strQueryName = "qryDocCheckNumberDateModify"
varExists = DLookup("doc_index", strQueryName)
If varExists <> Me![tbDocIndex] Then 'dup record exists
MsgBox "The ABC number and birth date already exists. Change the ABC birth date and try again.", 0, "ABC"
basModifyBirthDate
Exit Function
End If
Else
If IsNull(Me![tbABCDate]) Or Me![tbABCDate] = "" Then
Me!Check = "N"
Me![tbABCDate] = Date
Me![tbABCDate] = Null
Else
Me!Check = "Y"
End If
strQueryName = "qryDocCheckNumberDateModify"
Me![tbDocIndex] = -1
varExists = DLookup("doc_index", strQueryName)
If varExists > 0 Then
MsgBox "The ABC number and birth date already exists. Change the ABC birth date and try again.", 0, "ABC"
basModifyBirthDate
Exit Function
End If
End If
CheckABCNumberDate = True
Exit_ABCAdd:
Exit Function
Err_ABCAdd:
MsgBox Err.Description, vbOKOnly, "ABC"
Resume Exit_ABCAdd
End Function
'----------------------------------------------------------------------
Private Sub NoChangesMade()
'JS ABC tab
'1 ----------------------------
If IsNull([tbABCNumber]) Then
[tbABCNumber] = ""
End If
If (g_tbABCNumber <> [tbABCNumber]) Then
g_IsChanged = False
End If
'2 ----------------------------
If IsNull([tbABCDate]) Then
[tbABCDate] = ""
End If
If (g_tbABCDate <> [tbABCDate]) Then
g_IsChanged = False
End If
'3 ----------------------------
If IsNull([cbStatus]) Then
[cbStatus] = ""
End If
If (g_cbStatus <> [cbStatus]) Then
g_IsChanged = False
End If
'4 ----------------------------
If IsNull([cbInternetApproved]) Then
[cbInternetApproved] = ""
End If
If (g_cbInternetApproved <> [cbInternetApproved]) Then
g_IsChanged = False
End If
'5 ----------------------------
If IsNull([cbOprAgency]) Then
[cbOprAgency] = ""
End If
If (g_cbOprAgency <> [cbOprAgency]) Then
g_IsChanged = False
End If
'6 ----------------------------
If IsNull([cbSecurityClass]) Then
[cbSecurityClass] = ""
End If
If (g_cbSecurityClass <> [cbSecurityClass]) Then
g_IsChanged = False
End If
'7 ----------------------------
If IsNull([tbTitle]) Then
[tbTitle] = ""
End If
If (g_tbTitle <> [tbTitle]) Then
g_IsChanged = False
End If
'8 ----------------------------
If IsNull([tbShortTitle]) Then
[tbShortTitle] = ""
End If
If (g_tbShortTitle <> [tbShortTitle]) Then
g_IsChanged = False
End If
'9 ----------------------------
If IsNull([cbType]) Then
[cbType] = ""
End If
If (g_cbType <> [cbType]) Then
g_IsChanged = False
End If
'10 ----------------------------
If IsNull([cbSubType]) Then
[cbSubType] = ""
End If
If (g_cbSubType <> [cbSubType]) Then
g_IsChanged = False
End If
'11 ----------------------------
If IsNull([tbNumberOfPages]) Then
[tbNumberOfPages] = ""
End If
If (g_tbNumberOfPages <> [tbNumberOfPages]) Then
g_IsChanged = False
End If
'12 ----------------------------
If IsNull([tbCmdDist]) Then
[tbCmdDist] = ""
End If
If (g_tbCmdDist <> [tbCmdDist]) Then
g_IsChanged = False
End If
'13 ----------------------------
If IsNull([tbOriginalAO]) Then
[tbOriginalAO] = ""
End If
If (g_tbOriginalAO <> [tbOriginalAO]) Then
g_IsChanged = False
End If
'14 ----------------------------
If IsNull([tbInactiveReason]) Then
[tbInactiveReason] = ""
End If
If (g_tbInactiveReason <> [tbInactiveReason]) Then
g_IsChanged = False
End If
'15 ----------------------------
If IsNull([tbCancellationDate]) Then
[tbCancellationDate] = ""
End If
If (g_tbCancellationDate <> [tbCancellationDate]) Then
g_IsChanged = False
End If
'16 ----------------------------
If IsNull([tbSpecialTag]) Then
[tbSpecialTag] = ""
End If
If (g_tbSpecialTag <> [tbSpecialTag]) Then
g_IsChanged = False
End If
'17 ----------------------------
If IsNull([tbFileLocation]) Then
[tbFileLocation] = ""
End If
If (g_tbFileLocation <> [tbFileLocation]) Then
g_IsChanged = False
End If
'18 ----------------------------
If IsNull([tbSpecialTagRemark]) Then
[tbSpecialTagRemark] = ""
End If
If (g_tbSpecialTagRemark <> [tbSpecialTagRemark]) Then
g_IsChanged = False
End If
'19 ----------------------------
If IsNull([tbAvailable]) Then
[tbAvailable] = ""
End If
If (g_tbAvailable <> [tbAvailable]) Then
g_IsChanged = False
End If
'20 ----------------------------
If IsNull([tbSystem]) Then
[tbSystem] = ""
End If
If (g_tbSystem <> [tbSystem]) Then
g_IsChanged = False
End If
'21 ----------------------------
If IsNull([cbReviewRequired]) Then
[cbReviewRequired] = ""
End If
If (g_cbReviewRequired <> [cbReviewRequired]) Then
g_IsChanged = False
End If
'22 ----------------------------
If IsNull([tbFiscalYear]) Then
[tbFiscalYear] = ""
End If
If (g_tbFiscalYear <> [tbFiscalYear]) Then
g_IsChanged = False
End If
'23 ----------------------------
If IsNull([tbNextReviewDate]) Then
[tbNextReviewDate] = ""
End If
If (g_tbNextReviewDate <> [tbNextReviewDate]) Then
g_IsChanged = False
End If
'24 ----------------------------
If IsNull([OpgrpStocked]) Then
[OpgrpStocked] = ""
End If
If (g_OpgrpStocked <> [OpgrpStocked]) Then
g_IsChanged = False
End If
'If g_IsChanged Then
' g_IsChanged = False
'End If
'Review tab
'----------------------------
If IsNull([tbTaskedDate]) Then
[tbTaskedDate] = ""
End If
If (g_strTaskedDate <> [tbTaskedDate]) Then
g_IsChanged = False
End If
'------------------------------------
If IsNull([cbReviewType]) Then
[cbReviewType] = ""
End If
If (g_strReviewType <> [cbReviewType]) Then
g_IsChanged = False
End If
'--------------------------------
If IsNull([tbActionNumber]) Then
[tbActionNumber] = ""
End If
If (g_strActionNumber <> [tbActionNumber]) Then
g_IsChanged = False
End If
'----------------------------
If IsNull([tbSuspenseDate]) Then
[tbSuspenseDate] = ""
End If
If (g_strSuspenseDate <> [tbSuspenseDate]) Then
g_IsChanged = False
End If
'--------------------
If IsNull([tbReviewCompleted]) Then
[tbReviewCompleted] = ""
End If
If (g_strReviewCompleted <> [tbReviewCompleted]) Then
g_IsChanged = False
End If
'-------------------------------
If IsNull([cb2Status]) Then
[cb2Status] = ""
End If
If (g_str2Status <> [cb2Status]) Then
g_IsChanged = False
End If
'-----------------------
If IsNull([tbReviewerAO]) Then
[tbReviewerAO] = ""
End If
If (g_strReviewerAO <> [tbReviewerAO]) Then
g_IsChanged = False
End If
'------------------------------
If IsNull([tbAOPhone]) Then
[tbAOPhone] = ""
End If
If (g_strAOPhone <> [tbAOPhone]) Then
g_IsChanged = False
End If
End Sub
Public Sub SetFormToViewOnly(frm As Form)
' Call SetTextBoxProperties procedure.
'SetFormToViewOnly Me
'Sub SetTextBoxProperties(frm As Form)
Dim ctl As Control
' Enumerate Controls collection.
For Each ctl In frm.Controls
' Check to see if control is text box.
If ctl.ControlType = Toolbar Then
' Set control properties.
If ctl.Item = 2 Then
With ctl
'.Locked = True
'.BackColor = GREY
.Enabled = False
End With
End If
End If
Next ctl
End Sub
Private Sub Command241_Click()
On Error GoTo Err_Command241_Click
gChoice = True
gSetClearDefault (gChoice)
Exit_Command241_Click:
Exit Sub
Err_Command241_Click:
MsgBox Err.Description, vbOKOnly, "ABC"
Resume Exit_Command241_Click
End Sub
Private Sub txtIncSrch_Change()
Call adhIncSearch(Me!txtIncSrch, Me!lstIncSrch, "Company")
End Sub
Private Sub txtIncSrch_Exit(Cancel As Integer)
Call adhUpdateSearch(Me!txtIncSrch, Me!lstIncSrch)
End Sub
