Work around for Error 2046?

[steve711]

I have searched in vain folks. I tried the microsoft website relating to the known bug about Error 2046 as it relates to openform using the docmd but I couldn't get it to work, either work around of the 2 listed.

So I come to you all.

My problem. I have a form that opens and the kind user enters his/her information into and then they click SAVE. Naturally I have a little "better mousetrap" YES/NO/CANCEL window appear that is coded with cases for each option.

YES being the norm (they are sure they want to save it so do it) they click it the nice little option goes away and promptly returns them to the same window they just entered there stuff into and not back to the main menu as it had forever up until now. So they of course being the good users try it again with the same results. Forever basically until they get sick of it and then they call me.

I get no error messages and no saving of the record NOTHING.

Can someone enlighten me on how best to work around or better fix this problem?

Thanks.

 

[Robert88]

Hi Steve711,

Is it possible to reveal the code under the SAVE button?

Robert88

 

[steve711]

Here you go...

Private Sub bSave_Click()
'Get status of the aircraft
blankec = IsNull(Me.txtEC130)
blankas = IsNull(Me.txtAS350)
blankb206 = IsNull(Me.txtB206)


On Error GoTo Err_bSave_Click

    Beep
    Select Case MsgBox("Do you want to save your changes to the current record?" & vbCrLf & vbLf & "  Yes:         Saves Changes" & vbCrLf & "  No:          I need to fix something" & vbCrLf & "  Cancel:    DO NOT Save and Close" & vbCrLf, vbYesNoCancel + vbQuestion, "Save Current Record?")
    
    Case vbYes: 'Save the changes
    'Error check form before they can leave
        
    If IsNull(Me.tblBase.Value) Then
        MsgBox "You cannot have a blank in the Base Location field.  Enter a valid base.:"
        Me.cboBase.SetFocus
    End If
    If Me.txtAC.Value > 0 And IsNull(Me.txtEC130) Then
        MsgBox "You must enter an Aircraft # (ie. 39,38,41)"
        Me.txtEC130.SetFocus
        Exit Sub
    End If
    If Me.txtAC2.Value > 0 And IsNull(Me.txtAS350) Then
        MsgBox "You must enter an Aircraft # (ie. 32,33,25)"
        Me.txtAS350.SetFocus
        Exit Sub
    End If
    If Me.txtAC3.Value > 0 And IsNull(Me.txtB206) Then
        MsgBox "You must enter an Aircraft # (ie. 2,4)"
        Me.txtB206.SetFocus
        Exit Sub
    End If
    
    If IsNull(Me.txtTime_out) Then
        MsgBox "You must enter a valid Time-Out."
        Me.txtTime_out.SetFocus
        Exit Sub
    End If
       
    If IsNull(Me.txtTime_In.Value) Then
        MsgBox "You must enter a valid Time-In."
        Me.txtTime_In.SetFocus
        Exit Sub
    End If

    If blankec = False Then
        If Val(Me.txtEC130) <> Int(Val(Me.txtEC130)) Then
            MsgBox "Invalid Entry.  Please Enter Aircraft Number.  Example 38,39,41,ect."
            Cancel = True
            Me.txtEC130.SetFocus
            Exit Sub
        End If
    End If
    
    If blankas = False Then
        If Val(Me.txtAS350) <> Int(Val(Me.txtAS350)) Then
            MsgBox "Invalid Entry.  Please Enter Aircraft Number.  Example 32,33,35,ect."
            Cancel = True
            Me.txtAS350.SetFocus
            Exit Sub
        End If
    End If
    
    If IsNull(Me.txtDay_Landings) And Me.txtDay.Value > 0 Then
        MsgBox "You must enter your day landings."
        Me.txtDay_Landings.SetFocus
        Exit Sub
    End If
    If IsNull(Me.txtNight) And Me.txtNight_Landings = 0 Then
        MsgBox "You must enter your night landings."
        Me.txtNight_Landings.SetFocus
        Exit Sub
    End If
            
DoCmd.RunCommand acCmdSaveRecord
            'Update Pay Period now
            orgpayperiod = 0: orgrev = 0
            orgpayperiod = Me.txtPay_Period.Value
            orgrev = Me.txtRevenue_Hours.Value
            Me.txtPay_Period.Value = orgpayperiod + orgrev
            
            'Check which tail number was flown and place the N number in the block
            If Me.txtChampaign > 0 Then
                Dim rec As Recordset
                Dim db As Database

                Set db = CurrentDb()
                Set rec = db.OpenRecordset("tblAircraft")
                
                ct_num1 = Me.txtEC130: ct_num2 = Me.txtAS350: ct_num3 = Me.txtB206
                If IsNull(ct_num1) Then
                   'Look up the tail number
                    On Error Resume Next
                    'Compare the entered with table to find the match
                    rec.Index = "Aircraft_Tail"
                    rec.Seek "=", Me.txtAS350
                    myreg_num = rec("Reg_Num")
                    Me.txtN_Num = myreg_num
                    rec.Close
                Else
                'Look up the tail number
                On Error Resume Next
                'Compare the entered with table to find the match
                    rec.Index = "Aircraft_Tail"
                    rec.Seek "=", Me.txtEC130
                    myreg_num = rec("Reg_Num")
                    Me.txtN_Num = myreg_num
                    rec.Close
                End If
            End If
            DoCmd.Close
            DoCmd.OpenForm "DetectIdleTime", , , , , acHidden

        
        Case vbNo: 'Do not save or undo
            'Do nothing
            
        Case vbCancel: 'Undo the changes
            DoCmd.RunCommand acCmdUndo
            DoCmd.Close
            DoCmd.OpenForm "DetectIdleTime", , , , , acHidden

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

    End Select

Exit_bSave_Click:
    Exit Sub

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