Problem with MouseTrap sample after securing database

S

sara82

Registered User.
Local time
Today, 12:45
Joined
May 29, 2005
Messages
87
ghudson:

I am experiencing a problem with the mousetrap sample after I secured my database.

When I save on my main form and I try to go to my subform I keep getting the "Please Save this Record! You can not advance to another record until you either 'Save' the changes made to this record or 'Undo' your changed."

I have saved but it is still preventing me from going to the my subform. I numbered the Save Required msgs so that I know which one I am getting and I am getting the one from:

Code: 
 Private Sub Form_BeforeUpdate(Cancel As Integer)
On Error GoTo Err_Form_BeforeUpdate
    
    Me.tbHidden.SetFocus
    
    If Me.tbProperSave.Value = "No" Then
        Beep
        MsgBox "Please Save This Record!" & vbCrLf & vbLf & "You can not advance to another record until you either 'Save' the changes made to this record or 'Undo' your changes.7", vbExclamation, "Save Required"
        DoCmd.CancelEvent
        Exit Sub
    End If

Exit_Form_BeforeUpdate:
    Exit Sub

Err_Form_BeforeUpdate:
    If Err = 3020 Then  'Update or CancelUpdate without AddNew or Edit
        Exit Sub
    Else
        MsgBox Err.Number, Err.Description
        Resume Exit_Form_BeforeUpdate
    End If

End Sub

Above it is checking if tbProperSave.Value = "No" and in bSave you have
Case vbYes: 'Save the changes
Me.tbProperSave.Value = "Yes"
DoCmd.RunCommand acCmdSaveRecord
Me.tbProperSave.Value = "No"

So it's setting the value to no again?

I know it's not a permissions thing because I am admin and have full permissions on the forms.

Any suggestions?
 
You would have to post your db for I can not guess what is wrong. I do suggest that you ensure all of the coding is correct in your main form and the sub form since my A better mouse trap? sample using a sub form works fine.
 
My DB is 2.21 MB and that is over the limit. What is an alternative way to send it to you?

I checked the code line by line and compared yours with it and it is all the same.
 
ghudson, I am trying to troubleshoot the problem and it may have something do to with the add button or opening the form in add mode. When I have the add button on the form and you click it it allows you to type in the main form and then go on to the subform fine.

But I didn't want to have the add button on the frmTONumber. Currently what I have is a Main Menu form where you can with cmdAdd which will open up frmTONumber in add mode


Code: 
Private Sub cmdAdd_Click()
On Error GoTo Err_cmdAdd_Click
   'Opens frmTOnumber in Add mode
   DoCmd.OpenForm "frmTONumber", , , , acFormAdd
   
Exit_cmdAdd_Click:
    Exit Sub

Err_cmdAdd_Click:
    MsgBox Err.Description
    Resume Exit_cmdAdd_Click
End Sub

When I do it that way I can fill in the text boxes in the main form but when I go to the subform it keeps telling me "save required" even though I have already saved it.
 
frmTONumber Code:

Code: 
Option Compare Database
Option Explicit

Private Sub cmdClose_Click()
 'Prompts the user to save the current record if it needs to be saved.
    If Me.Dirty Then
    MsgBox "Current T.O. has been modified." & vbCrLf & vbLf & "Please save the T.O.1", vbCritical + vbOKOnly, "Save Required"
    Else
    'Closes the Form
        DoCmd.Close acForm, Me.Name
    End If

Exit_cmdClose_Click:
    Exit Sub

Err_cmdClose_Click:
    MsgBox Err.Number, Err.Description
    Resume Exit_cmdClose_Click
End Sub

Private Sub cmdFirst_Click()
On Error GoTo Err_cmdFirst_Click

'Prompts the user to save the current record if it needs to be saved.
If Me.Dirty Then
MsgBox "Current T.O. has been modified." & vbCrLf & vbLf & "Please save the T.O.2", vbCritical + vbOKOnly, "Save Required"
Else
'Go to First record
DoCmd.GoToRecord , , acFirst
'Updates the Work Log Summary
Me.lstSummary.Requery
End If

Exit_cmdFirst_Click:
  Exit Sub
    
Err_cmdFirst_Click:
  MsgBox Err.Description
  Resume Exit_cmdFirst_Click

End Sub

Private Sub cmdLast_Click()
On Error GoTo Err_cmdLast_Click

'Prompts the user to save the current record if it needs to be saved.
If Me.Dirty Then
MsgBox "Current T.O. has been modified." & vbCrLf & vbLf & "Please save the T.O.3", vbCritical + vbOKOnly, "Save Required"
Else
'Go to Last record
DoCmd.GoToRecord , , acLast
'Updates the Work Log Summary
Me.lstSummary.Requery
End If

Exit_cmdLast_Click:
  Exit Sub
    
Err_cmdLast_Click:
  MsgBox Err.Description
  Resume Exit_cmdLast_Click

End Sub

Private Sub cmdNew_Click()
On Error GoTo Err_cmdNew_Click

'Prompts the user to save the current record if it needs to be saved.
If Me.Dirty Then
MsgBox "Current T.O. has been modified." & vbCrLf & vbLf & "Please save the T.O.4", vbCritical + vbOKOnly, "Save Required"
Else
'Adds a new record
DoCmd.GoToRecord , , acNewRec
'Updates the Work Log Summary
Me.lstSummary.Requery
End If

Exit_cmdNew_Click:
  Exit Sub
    
Err_cmdNew_Click:
  MsgBox Err.Description
  Resume Exit_cmdNew_Click

End Sub

Private Sub cmdNext_Click()
On Error GoTo Err_cmdNext_Click

'Prompts the user to save the current record if it needs to be saved.
If Me.Dirty Then
MsgBox "Current T.O. has been modified." & vbCrLf & vbLf & "Please save the T.O.5", vbCritical + vbOKOnly, "Save Required"
Else
'Go to Next Record
DoCmd.GoToRecord , , acNext
'Updates the Work Log Summary
Me.lstSummary.Requery
End If

Exit_cmdNext_Click:
  Exit Sub
    
Err_cmdNext_Click:
  MsgBox Err.Description
  Resume Exit_cmdNext_Click

End Sub

Private Sub cmdPrevious_Click()
On Error GoTo Err_cmdPrevious_Click

'Prompts the user to save the current record if it needs to be saved.
If Me.Dirty Then
MsgBox "Current T.O. has been modified." & vbCrLf & vbLf & "Please save the T.O.6", vbCritical + vbOKOnly, "Save Required"
Else
'Go to Previous Record
DoCmd.GoToRecord , , acPrevious
'Updates the Work Log Summary
Me.lstSummary.Requery
End If

Exit_cmdPrevious_Click:
  Exit Sub
    
Err_cmdPrevious_Click:
  MsgBox Err.Description
  Resume Exit_cmdPrevious_Click

End Sub


Private Sub cmdSave_Click()
On Error GoTo Err_cmdSave_Click

'Required fields the user has to enter before being able to save
    If IsNull(txtTONumber) Then
        MsgBox "T.O. Number must be entered before you can save the record.", vbCritical, "Invalid Save"
        txtTONumber.SetFocus
    ElseIf IsNull(cboProductDirectorate) Then
        MsgBox "Product Directorate must be entered before you can save the record.", vbCritical, "Invalid Save"
        cboProductDirectorate.SetFocus
   
Else
    'Prompts the user to save the current record or cancel or undo changes made
    Select Case MsgBox("Do you want to save your changes to the T.O.?" & vbCrLf & vbLf & "Yes:         Save Changes" & vbCrLf & vbLf & "No:          Do NOT Save Changes" & vbCrLf & vbLf & "Cancel:    Undo Changes" & vbCrLf, vbYesNoCancel + vbQuestion, "Save Current T.O.?")
        Case vbYes: 'Save the changes
            Me.tbProperSave.Value = "Yes"
            DoCmd.RunCommand acCmdSaveRecord
            Me.tbProperSave.Value = "No"

        Case vbNo: 'Do not save or undo
            'Do nothing

        Case vbCancel: 'Undo the changes
            DoCmd.RunCommand acCmdUndo
            Me.tbProperSave.Value = "No"

        Case Else: 'Default case to trap any errors
            'Do nothing
    End Select
End If

Exit_cmdSave_Click:
    Exit Sub

Err_cmdSave_Click:
    If Err = 2046 Then 'The command or action Undo is not available now
        Exit Sub
    Else
        MsgBox Err.Number, Err.Description
        Resume Exit_cmdSave_Click
    End If
    
End Sub


Private Sub cmdTracking_Click()
On Error GoTo Err_cmdTracking_Click

    Dim stDocName As String

    stDocName = "TrackingLog"
    DoCmd.OpenReport stDocName, acPreview
    

Exit_cmdTracking_Click:
    Exit Sub

Err_cmdTracking_Click:
    MsgBox Err.Description
    Resume Exit_cmdTracking_Click
    
End Sub


Private Sub cmdUndo_Click()
On Error GoTo Err_cmdUndo_Click

      'Resets the record if it has been modified by the user.
    If Me.Dirty Then
        Beep
        DoCmd.RunCommand acCmdUndo
        Me.tbProperSave.Value = "No"
    Else
        Beep
        MsgBox "There were no modifications made to the current record.", vbInformation, "Invalid Undo"
    End If

Exit_cmdUndo_Click:
    Exit Sub

Err_cmdUndo_Click:
    MsgBox Err.Number, Err.Description
    Resume Exit_cmdUndo_Click
    
End Sub

Private Sub Form_BeforeUpdate(Cancel As Integer)

On Error GoTo Err_Form_BeforeUpdate
    
     If Me.tbProperSave.Value = "No" Then
        Beep
        MsgBox "Please save the T.O.7", vbCritical + vbOKOnly, "Save Required"
        DoCmd.CancelEvent
        Exit Sub
    End If

Exit_Form_BeforeUpdate:
    Exit Sub

Err_Form_BeforeUpdate:
    If Err = 3020 Then  'Update or CancelUpdate without AddNew or Edit
        Exit Sub
    Else
        MsgBox Err.Number, Err.Description
        Resume Exit_Form_BeforeUpdate
    End If


End Sub

Private Sub Form_Current()
    
On Error GoTo Err_Form_Current

    Me!txtTONumber.SetFocus
    
    Me.tbProperSave.Value = "No"
    
    'Displays the current record number
    Me!txtCurrent = Me.CurrentRecord
    Me.RecordsetClone.MoveLast
    Me!txtTotal = RecordsetClone.RecordCount + Abs(Me.NewRecord) 'Displays the total number of records

Dim recClone As Object
Dim intNewRecord As Integer

' If this is a "New Record" then
' Disable the <Next>, <New>, <Last> buttons
' Enable the <First> and <Previous> buttons
' Then Exit the procedure.

If Me.NewRecord Then
  cmdFirst.Enabled = True
  cmdNext.Enabled = False
  cmdPrevious.Enabled = True
  cmdLast.Enabled = False
  cmdNew.Enabled = False
  Me.txtTONumber.SetFocus ' Set focus to the TO Number if a "New Record"
  Exit Sub
Else
  ' Else if this is not a new record
  ' Enable <New> and <Last> buttons
  cmdNew.Enabled = True
  cmdLast.Enabled = True
End If

' Make a clone of the recordset underlying the form so
' we can move around without affecting the form's recordset
Set recClone = Me.RecordsetClone

' Check to see if there are no records
' If so disable all buttons except for the <New> button
If recClone.RecordCount = 0 Then
  cmdNext.Enabled = False
  cmdPrevious.Enabled = False
  cmdFirst.Enabled = False
  cmdLast.Enabled = False
Else
  ' Synchronise the current pointer in the two recordsets
  recClone.Bookmark = Me.Bookmark
  ' If there are records, see if recordset is on the first record
  ' If so, disable the <First> and <Previous> buttons
  recClone.MovePrevious
  cmdFirst.Enabled = Not (recClone.BOF)
  cmdPrevious.Enabled = Not (recClone.BOF)
  recClone.MoveNext
  ' And then check whether recordset is on the last record
  ' If so, disable the <Last> and <Next> buttons
  recClone.MoveNext
  cmdLast.Enabled = Not (recClone.EOF)
  cmdNext.Enabled = Not (recClone.EOF)
  recClone.MovePrevious
End If

recClone.Close

Exit_Form_Current:
  Exit Sub
    
Err_Form_Current:
  If Err = 3021 Then
    ' Error 3021 means recordset is at Add New Record
    ' Enable <Previous> and <First> buttons
    ' Disable <Next> and <Last> buttons
    cmdPrevious.Enabled = True
    cmdFirst.Enabled = True
    cmdNext.Enabled = False
    cmdLast.Enabled = False
    Resume Exit_Form_Current
  Else
    MsgBox Err.Description
    Resume Exit_Form_Current
  End If
    
End Sub

Private Sub frmTOItems_Enter()
'If TO Number is blank cannot go to subform
If IsNull(Me![txtTONumber]) Then
      MsgBox "Enter TO Number before entering Item Details.", vbCritical, "Enter T.O. Number"
      Forms![frmTONumber]![txtTONumber].SetFocus
   
    End If
End Sub

Private Sub txtCurrent_AfterUpdate()
'Displays the current record number and also allows the user to enter a record number to go to
    If IsNumeric(Me!txtCurrent) Then
        If CLng(Me!txtCurrent) >= 0 And CLng(Me!txtCurrent) <= Me!txtTotal Then
            Me.RecordsetClone.AbsolutePosition = Me!txtCurrent - 1
            Me.Bookmark = Me.RecordsetClone.Bookmark
        Else
            Me!txtCurrent = Me.CurrentRecord
        End If
    Else
        Me!txtCurrent = Me.CurrentRecord
    End If
    'Updates the Work Log Summary
    Me.lstSummary.Requery
     
    
End Sub
 
subform frmTOItems code

Code: 
Option Compare Database
Option Explicit

Private Sub cmdFirst_Click()
On Error GoTo Err_cmdFirst_Click

If Me.Dirty Then
MsgBox "Current ITEM has been modified." & vbCrLf & vbLf & "Please save the ITEM", vbCritical + vbOKOnly, "Save Required"
Else
'Go to First record
DoCmd.GoToRecord , , acFirst
End If

Exit_cmdFirst_Click:
  Exit Sub
    
Err_cmdFirst_Click:
  MsgBox Err.Description
  Resume Exit_cmdFirst_Click

End Sub

Private Sub cmdLast_Click()
On Error GoTo Err_cmdLast_Click

If Me.Dirty Then
MsgBox "Current ITEM has been modified." & vbCrLf & vbLf & "Please save the ITEM", vbCritical + vbOKOnly, "Save Required"
Else
'Go to Last record
DoCmd.GoToRecord , , acLast
End If

Exit_cmdLast_Click:
  Exit Sub
    
Err_cmdLast_Click:
  MsgBox Err.Description
  Resume Exit_cmdLast_Click

End Sub

Private Sub cmdNew_Click()
On Error GoTo Err_cmdNew_Click

If Me.Dirty Then
MsgBox "Current ITEM has been modified." & vbCrLf & vbLf & "Please save the ITEM", vbCritical + vbOKOnly, "Save Required"
Else
'Adds a new record
DoCmd.GoToRecord , , acNewRec
End If

Exit_cmdNew_Click:
  Exit Sub
    
Err_cmdNew_Click:
  MsgBox Err.Description
  Resume Exit_cmdNew_Click

End Sub

Private Sub cmdNext_Click()
On Error GoTo Err_cmdNext_Click

If Me.Dirty Then
MsgBox "Current ITEM has been modified." & vbCrLf & vbLf & "Please save the ITEM", vbCritical + vbOKOnly, "Save Required"
Else
'Go to Next Record
DoCmd.GoToRecord , , acNext
End If

Exit_cmdNext_Click:
  Exit Sub
    
Err_cmdNext_Click:
  MsgBox Err.Description
  Resume Exit_cmdNext_Click

End Sub

Private Sub cmdPrevious_Click()
On Error GoTo Err_cmdPrevious_Click

If Me.Dirty Then
MsgBox "Current ITEM has been modified." & vbCrLf & vbLf & "Please save the ITEM", vbCritical + vbOKOnly, "Save Required"
Else
'Go to Previous Record
DoCmd.GoToRecord , , acPrevious
End If

Exit_cmdPrevious_Click:
  Exit Sub
    
Err_cmdPrevious_Click:
  MsgBox Err.Description
  Resume Exit_cmdPrevious_Click

End Sub


Private Sub cmdSave_Click()
On Error GoTo Err_cmdSave_Click

    If IsNull(Product) Then
        MsgBox "Product must be entered before you can save the record.", vbCritical, "Invalid Save"
        Product.SetFocus
    'ElseIf IsNull(cboProductDirectorate) Then
        'MsgBox "Product Directorate must be entered before you can save the record.", vbCritical, "Invalid Save"
        'cboProductDirectorate.SetFocus
   
Else
    Beep
    Select Case MsgBox("Do you want to save your changes to the ITEM?" & vbCrLf & vbLf & "Yes:         Save Changes" & vbCrLf & vbLf & "No:          Do NOT Save Changes" & vbCrLf & vbLf & "Cancel:    Undo Changes" & vbCrLf, vbYesNoCancel + vbQuestion, "Save Current ITEM?")
        Case vbYes: 'Save the changes
            Forms![frmTONumber]![tbProperSave].Value = "Yes"
            DoCmd.RunCommand acCmdSaveRecord
            
        Case vbNo: 'Do not save or undo
            'Do nothing

        Case vbCancel: 'Undo the changes
            DoCmd.RunCommand acCmdUndo
            Forms![frmTONumber]![tbProperSave].Value = "No"

        Case Else: 'Default case to trap any errors
            'Do nothing
    End Select
End If

Exit_cmdSave_Click:
    Exit Sub

Err_cmdSave_Click:
    If Err = 2046 Then 'The command or action Undo is not available now
        Exit Sub
    Else
        MsgBox Err.Number, Err.Description
        Resume Exit_cmdSave_Click
    End If
    
End Sub



Private Sub Form_BeforeUpdate(Cancel As Integer)
On Error GoTo Err_Form_BeforeUpdate
    
    If Forms![frmTONumber]![tbProperSave].Value = "No" Then
        Beep
        MsgBox "Please save the ITEM", vbCritical + vbOKOnly, "Save Required"
        DoCmd.CancelEvent
        Exit Sub
    End If

Exit_Form_BeforeUpdate:
    Exit Sub

Err_Form_BeforeUpdate:
    If Err = 3020 Then  'Update or CancelUpdate without AddNew or Edit
        Exit Sub
    Else
        MsgBox Err.Number, Err.Description
        Resume Exit_Form_BeforeUpdate
    End If

End Sub

Private Sub Form_Current()
    
On Error GoTo Err_Form_Current
   
    'Displays the current record number
    Me!txtCurrent = Me.CurrentRecord
    Me.RecordsetClone.MoveLast
    Me!txtTotal = RecordsetClone.RecordCount + Abs(Me.NewRecord)

Dim recClone As Object
Dim intNewRecord As Integer

' If this is a "New Record" then
' Disable the <Next>, <New>, <Last> buttons
' Enable the <First> and <Previous> buttons
' Then Exit the procedure.

If Me.NewRecord Then
  cmdFirst.Enabled = True
  cmdNext.Enabled = False
  cmdPrevious.Enabled = True
  cmdLast.Enabled = False
  cmdNew.Enabled = False
 
  Exit Sub
Else
  ' Else if this is not a new record
  ' Enable <New> and <Last> buttons
  cmdNew.Enabled = True
  cmdLast.Enabled = True
End If

' Make a clone of the recordset underlying the form so
' we can move around without affecting the form's recordset
Set recClone = Me.RecordsetClone

' Check to see if there are no records
' If so disable all buttons except for the <New> button
If recClone.RecordCount = 0 Then
  cmdNext.Enabled = False
  cmdPrevious.Enabled = False
  cmdFirst.Enabled = False
  cmdLast.Enabled = False
Else
  ' Synchronise the current pointer in the two recordsets
  recClone.Bookmark = Me.Bookmark
  ' If there are records, see if recordset is on the first record
  ' If so, disable the <First> and <Previous> buttons
  recClone.MovePrevious
  cmdFirst.Enabled = Not (recClone.BOF)
  cmdPrevious.Enabled = Not (recClone.BOF)
  recClone.MoveNext
  ' And then check whether recordset is on the last record
  ' If so, disable the <Last> and <Next> buttons
  recClone.MoveNext
  cmdLast.Enabled = Not (recClone.EOF)
  cmdNext.Enabled = Not (recClone.EOF)
  recClone.MovePrevious
End If

recClone.Close

Exit_Form_Current:
  Exit Sub
    
Err_Form_Current:
  If Err = 3021 Then
    ' Error 3021 means recordset is at Add New Record
    ' Enable <Previous> and <First> buttons
    ' Disable <Next> and <Last> buttons
    cmdPrevious.Enabled = True
    cmdFirst.Enabled = True
    cmdNext.Enabled = False
    cmdLast.Enabled = False
    Resume Exit_Form_Current
  Else
    MsgBox Err.Description
    Resume Exit_Form_Current
  End If
    
End Sub



Private Sub txtCurrent_AfterUpdate()

'Displays the current record number and also allows the user to enter a record number to go to
    If IsNumeric(Me!txtCurrent) Then
        If CLng(Me!txtCurrent) >= 0 And CLng(Me!txtCurrent) <= Me!txtTotal Then
            Me.RecordsetClone.AbsolutePosition = Me!txtCurrent - 1
            Me.Bookmark = Me.RecordsetClone.Bookmark
        Else
            Me!txtCurrent = Me.CurrentRecord
        End If
    Else
        Me!txtCurrent = Me.CurrentRecord
    End If

End Sub
 
Are you getting the message about saving because the record is 'dirty'? If so then the record really is not saved, yet.

If I recall correctly, you have a form embedded into another form plus a subform or two. If that is near true then I think I mentioned before that you are over complicating your form. Which sounds about right for something that should be simple. At least it is for me and the sample I posted for I have never had any problems using my method.

Working out the kink will be a challenge for you with the way you have your forms setup. Before tearing things apart you might want to try a quick test by creating as much of the form objects in just one form. Ensure it all works as expected before adding a subform.
 
All I have is 1 form (frmTONumber) with 1 subform (frmTOItems)
I'll do that test and see how it goes.

ghudson said:
If I recall correctly, you have a form embedded into another form plus a subform or two. If that is near true then I think I mentioned before that you are over complicating your form. Which sounds about right for something that should be simple. At least it is for me and the sample I posted for I have never had any problems using my method.
.
Click to expand...
 
You must log in or register to reply here.

Similar threads

W
How to Populate a Control in Code and Make it Behave As Though Populated in the GUI
Replies
10
Views
510
arnelgp
arnelgp
T
Cancel,Save and Delete buttons for Order form
Replies
7
Views
1,384
jwcolby54
jwcolby54
R
How do I save the layout of a subform after modifying it on the main form's on open event?
Replies
12
Views
1,107
RickSanchez
R
I
Solved Error about assigning Null value when clicking away from deleted form field
Replies
15
Views
1,062
The_Doc_Man
The_Doc_Man
Q
Solved combo box after update event
Replies
17
Views
1,657
June7
June7

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Back
Top Bottom