How to get module/form to save after update? (1 Viewer)

[Garindan]

Hi all. I have a button on a form which calls a module to show a calendar form. The user picks date and time, and saves it. The calendar form closes and adds the date and time to a text box on the initial form.

At that point I want to save the record so that the underlying table/query is updated, but it's not working. The record is not saved until the initial form is closed.

Here's the form vba...

Option Compare Database
Option Explicit

Private blnFlag As Boolean, blnSaveIt As Boolean

Private Sub btnDelete_Click()
On Error GoTo Err_btnDelete_Click


    DoCmd.RunCommand acCmdSelectRecord
    DoCmd.RunCommand acCmdDeleteRecord

Exit_btnDelete_Click:
    Exit Sub

Err_btnDelete_Click:
    MsgBox Err.Description
    Resume Exit_btnDelete_Click
    
End Sub
Private Sub btnDeleteAlarm_Click()

    If MsgBox("Are you sure you wish to delete the alarm?", vbOKCancel, "Warning") = vbOK Then

        Me.txtCommentAlarm = Null
        Me.txtComputerName = Null
        Me.cbAlarmSet = 0
        
    End If
    
End Sub

Private Sub btnOpenAlarmFrm_Click()
    Call GetDate([Form]![txtCommentAlarm], 0)
    Call Form_BeforeUpdate(False)
    If blnSaveIt = True Then DoCmd.RunCommand acCmdSaveRecord
End Sub


Private Sub Comments_AfterUpdate()
    blnFlag = True
    Me![txtCommentDate_Time] = Now()
    If Me.Dirty Then
        Me.Dirty = False
    End If
    blnFlag = False
End Sub

Private Sub Form_BeforeUpdate(Cancel As Integer)
    If blnFlag = False Then
    If IsDate(Me![txtCommentAlarm]) Then
    Me![txtComputerName] = Environ("Computername")
    Me![cbAlarmSet] = -1
    If DCount("*", "tblCustomerComments", "[CommentAlarm]= #" & Format(Me![txtCommentAlarm], "mm\/dd\/yyyy hh:nn") & "#") > 0 Then ' It is a duplicate
        Cancel = True
        MsgBox "Sorry an alarm has already been set at this Date/Time, please enter a different Date/Time"
        Me.Undo  '<----Remove this if you don't want to erase form input
        blnSaveIt = False
    End If
    End If
    End If
End Sub

Private Sub txtCommentAlarm_AfterUpdate()
    DoCmd.RunCommand acCmdSaveRecord
End Sub

And here's the module vba...

Option Compare Database   'Use database order for string comparisons
Option Explicit

Public Sub GetDate(ctl As Control, Optional intDateOnly As Integer = -1)
'-----------------------------------------------------------
' Inputs: A Control object containing a date/time value
' Outputs: Sets the Control to the value returned by frmCalendar
' Created By: JLV 09/05/01
' Last Revised: JLV 09/05/01
'-----------------------------------------------------------
Dim varDateTime As Variant, strDateTime As String, frm As Form
Dim strFrm As String

strFrm = "frmCalendar"

    If IsNothing(ctl.Value) Then
        If intDateOnly Then
            varDateTime = Date
        Else
            varDateTime = Now
        End If
    Else
        varDateTime = ctl.Value
    End If
    strDateTime = Format(varDateTime, "dd-mmm-yyyy hh:nn")
    If CurrentProject.AllForms(strFrm).IsLoaded Then
      DoCmd.Close acForm, strFrm
    End If
    DoCmd.OpenForm strFrm, WindowMode:=acDialog, OpenArgs:=strDateTime & "," & intDateOnly
    ' User canceled the calendar dialog
    If Not CurrentProject.AllForms(strFrm).IsLoaded Then
      Exit Sub
    End If
    Set frm = Forms(strFrm)
    strDateTime = Format(frm.ctlCalendar.Value, "Short Date")
    If Not intDateOnly Then
        strDateTime = strDateTime & " " & frm.txtHour & ":" & frm.txtMinute
    End If
    ctl.Value = DateValue(strDateTime) + TimeValue(strDateTime)
    DoCmd.Close acForm, strFrm
    
End Sub


Public Function IsNothing(ByVal varValueToTest) As Integer
'-----------------------------------------------------------
' Does a "nothing" test based on data type.
'   Null = nothing
'   Empty = nothing
'   Number = 0 is nothing
'   String = "" is nothing
'   Date/Time is never nothing
' Inputs: A value to test for logical "nothing"
' Outputs: True = value passed is a logical "nothing", False = it ain't
' Created By: JLV 01/31/95
' Last Revised: JLV 01/31/95
'-----------------------------------------------------------
Dim intSuccess As Integer

    On Error GoTo IsNothing_Err
    IsNothing = True

    Select Case VarType(varValueToTest)
        Case 0      ' Empty
            GoTo IsNothing_Exit
        Case 1      ' Null
            GoTo IsNothing_Exit
        Case 2, 3, 4, 5, 6  ' Integer, Long, Single, Double, Currency
            If varValueToTest <> 0 Then IsNothing = False
        Case 7      ' Date / Time
            IsNothing = False
        Case 8      ' String
            If (Len(varValueToTest) <> 0 And varValueToTest <> " ") Then IsNothing = False
    End Select


IsNothing_Exit:
    On Error GoTo 0
    Exit Function

IsNothing_Err:
    IsNothing = True
    Resume IsNothing_Exit

End Function

Public Sub LoadYears(Optional intStart As Integer = 1950, Optional intEnd As Integer = 2099)
Dim db As DAO.Database, rst As DAO.Recordset, intI As Integer

    Set db = CurrentDb
    db.Execute "Delete * From tblYearsLookup", dbFailOnError
    Set rst = db.OpenRecordset("tblYearsLookup", dbOpenDynaset, dbAppendOnly)
    For intI = intStart To intEnd
        rst.AddNew
        rst!Year = intI
        rst.Update
    Next intI
    rst.Close
    Set rst = Nothing
    Set db = Nothing
    

End Sub

Many many thanks for any help!

 

[Uncle Gizmo]

The text box on me initial form, is it unbound?

 

[Garindan]

Sorry for slow reply... no, its bound.

It just doesn't recognise an update when its been updated from the module :bang head:

EDIT: I've tested it with after update, on dirty and on change. It doesn't recognise when its been updated!

 

[Garindan]

I've fixed this now!

I realised that 'If blnSaveIt = True Then DoCmd.RunCommand acCmdSaveRecord' was preventing the record from saving. I added 'Else blnSaveIt = True' and now it works.

I.e.

Private Sub btnOpenAlarmFrm_Click()
    Call GetDate([Form]![txtCommentAlarm], 0)
    Call Form_BeforeUpdate(False)
    If blnSaveIt = True Then DoCmd.RunCommand acCmdSaveRecord
End Sub

Private Sub Form_BeforeUpdate(Cancel As Integer)
    If blnFlag = False Then
    If IsDate(Me![txtCommentAlarm]) Then
    Me![txtComputerName] = Environ("Computername")
    Me![cbAlarmSet] = -1
    If DCount("*", "tblCustomerComments", "[CommentAlarm]= #" & Format(Me![txtCommentAlarm], "mm\/dd\/yyyy hh:nn") & "#") > 0 Then ' It is a duplicate
        Cancel = True
        MsgBox "Sorry an alarm has already been set at this Date/Time, please enter a different Date/Time"
        Me.Undo  '<----Remove this if you don't want to erase form input
        blnSaveIt = False
    Else
        blnSaveIt = True
    End If
    End If
    End If
End Sub

That looks good doesn't it?