Receiving Error: You must use the dbSeeChanges option with OpenRecordSet when accessing a SQL Server

[Cheryl73]

I have an MS Access 2010 (.mdb) application linked to a MS SQL Server 2008 R2 SP2 database on the backend. I am using an SQL Server ODBC connection driver. I am not using a SQL Server Native client driver.

When I run my application at some point I receive the following error:

You must use the dbSeeChanges option with OpenRecordSet when accessing a SQL Server table that has an IDENTITY column

The error happens when I double click on a item (record) in the list of the screen (on Form: frmABCList) in order to get the detail information for that record. Instead of receiving the detailed information filled out on the Form: frmABCDetail, I get the error message shown above, and the Form: frmABCDetail appears, but it is blank.

How can I correct this error and keep it from appearing?

Here is the code that I use for the detail section on Form frmABCList:

Private Sub Detail_Click()
On Error GoTo Error_Detail_Click

Dim db As DAO.Database

Dim rs As DAO.Recordset


Dim stDocName As String
Dim stLinkCriteria As String
stLinkCriteria = [doc_index]

stDocName = "frmABCDetail"

Set db = CurrentDb()

Set rs = db.OpenRecordset("qryDocumentList", dbOpenDynaset, dbSeeChanges)

With rs

.MoveFirst

.FindFirst ("[doc_index]= '" & Me![doc_index] & "'")

If .NoMatch Then

MsgBox "NO RECORDS MET REQUESTED CRITERIA.", "ADIMS"

Else

stLinkCriteria = Me.[doc_index]

DoCmd.OpenForm stDocName, , , stLinkCriteria, , , "Modify"

End If

rs.Close

db.Close

End With

'Check for no records
'If (Me.RecordsetClone.RecordCount <> 0) Then
'DoCmd.OpenForm stDocName, , , stLinkCriteria, , , "Modify"
'Else
' MsgBox "NO RECORDS MET REQUESTED CRITERIA.", "ABC App "
'End If
Exit_Detail_Click:
Exit Sub

Error_Detail_Click:
MsgBox Err.Description
Resume Exit_Detail_Click

End Sub

As you can see, I am using dbSeeChanges in my code, but I still get the error. Also, could the problem be caused by the .ldb file associated with the MS Access application?

Or could the problem be with the tblDocument table, which does use and has to use an IDENTITY column called 'doc_index'.

Any help would be greatly appreciated.

Thanks,

Cheryl73

 

[dhookom]

I'm surprised the code works without specifying a boolean expression like:

stLinkCriteria = "doc_Index = " & Me.[doc_index]

I would think your existing code would not filter out any records.

Is Doc_Index in the record source of frmABCDetail?

Duane
Hook'D on Access
MS Access MVP

 

[Cheryl73]

Hello.

No. It is not included in frmABCDetail as in its record source. It is not bound to a recordsource. I'll send you the code for frmABCDetail later to see how it is referenced in the receiving Access form.

Thanks for your assistance.

Cheryl73

 

[Cheryl73]

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

 

[dhookom]

That's over 1400 lines of code. What is the code for basModifyBirthDate?

Duane
Hook'D on Access
MS Access MVP

 

[1DMF]

Perhaps this line is the culprit :

Set MyRecordsABC = g_dbABC.OpenRecordset("qryABCDetail")

change to

Set MyRecordsABC = g_dbABC.OpenRecordset("qryABCDetail", dbOpenDynaset, dbSeeChanges)

Of course if you are only viewing the data and it's not to be edited, then use 'dbOpenSnapshot'

"In complete darkness we are all the same, it is only our knowledge and wisdom that separates us, don't let your eyes deceive you."

"If a shortcut was meant to be easy, it wouldn't be a shortcut, it would be the way!"
Free Electronic Dance Music