recording a last modified date/time for a form

[greenfibres]

Hello all
I have a table of contacts which I access through a form.
I would like to keep a record of the last time any of the contacts fields (name, address, tel. no., email, etc.) were changed. (I only need 1 field to be changed for the last modified flag to be relevant)
Any ideas?
Thanks
Jim

 

[PHV]

Add a DateTime field in your table of contacts and in your form add a control bound to this field.
Then, in the BeforeUpdate event procedure of the form:
Me![name of control] = Now()

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[greenfibres]

That's great thanks.
I tried it with a simple form and that works perfectly.

I'm now trying to apply it to a much more complex form which doesn't even have a beforeupdate event proceedure!

This may be a bridge too far, but I am posting the whole code below, and would appreciate your help in modyfying it so that it will also work as described before.
Thanks

Option Compare Database
Option Explicit

'these consts must correspond to fraPrintPreview
Private Const csPrint = 1
Private Const csPreview = 2

'which report are we printing
Private Const csInvoice = 1
Private Const csReturn = 2

'CustomerID of the Shop Customer
Private Const csShopCustID = 16618 'Gladys Clench!

Public bRunStockUpdate As Boolean

Private Declare Sub OpenTill Lib "gfTill.dll" (ByVal pszPort As String)
Private Const csComPort = "COM1"

Private WithEvents m_frmPrintInvoice As Form 'we will capture the close event
'next two properties are set by cmdInvoice, cmdReturn so that
'the m_frmPrintInvoice form object can decide how to call UpdateInventoryTransactions()
Private m_strComparisonOperator As String
Private m_varSelectedOrderID As Variant
'

'property methods
Public Property Let ComparisonOperator(sOperator As String)
m_strComparisonOperator = sOperator
End Property
Public Property Get ComparisonOperator() As String
ComparisonOperator = m_strComparisonOperator
End Property

Public Property Let SelectedOrderID(newVal As Variant)
m_varSelectedOrderID = newVal
End Property
Public Property Get SelectedOrderID() As Variant
SelectedOrderID = m_varSelectedOrderID
End Property

Private Sub FindShopCustomer()
Dim rs As Recordset

Set rs = Me.RecordsetClone
With rs
.FindFirst "CustomerID=" & csShopCustID
If .NoMatch Then
'do nothing
Else
Me.Bookmark = rs.Bookmark
End If
.Close
End With
End Sub

Private Sub cmdCustomersWithOrders_Click()
On Error Resume Next

DoCmd.OpenQuery queryname:="qryCustomersWithOrders"
End Sub

Private Sub cmdDeliveryNote_Click()
With fsubOrder
If .Form.RecordsetClone.RecordCount <= 0 Then
Exit Sub
Else
PrintDeliveryNote
End If
End With

End Sub

Private Sub cmdInvoice_Click()
With fsubOrder
If .Form.RecordsetClone.RecordCount <= 0 Then
Exit Sub
Else
Me.ComparisonOperator = ">="
Me.SelectedOrderID = Me![fsubOrder]!OrderID
PrintInvoiceOrReturn csInvoice, ">="
End If
End With
End Sub

Private Sub cmdPickList_Click()
With fsubOrder
If .Form.RecordsetClone.RecordCount <= 0 Then
Exit Sub
Else
PrintPickList
End If
End With
End Sub

Private Sub cmdReturn_Click()
With fsubOrder
If .Form.RecordsetClone.RecordCount <= 0 Then
Exit Sub
Else
Me.ComparisonOperator = ">="
Me.SelectedOrderID = Me![fsubOrder]!OrderID
PrintInvoiceOrReturn csReturn, "<"
End If
End With
End Sub

Private Sub cmdFindCust_Click()
Dim rsOrder As Recordset
Dim rsCustomer As Recordset
Dim db As Database
Dim sInvNo As String

If IsNull(Me!txtInvNo) Or Me!txtInvNo = "" Then
MsgBox "Enter an invoice number to find"
Exit Sub
End If

Set db = CurrentDb()
Set rsOrder = db.OpenRecordset("Orders")
With rsOrder
sInvNo = Me!txtInvNo
.FindFirst "OrderID=" & sInvNo
If .NoMatch Then
MsgBox "Could not find invoice number: " & sInvNo
Else
Set rsCustomer = Me.RecordsetClone
rsCustomer.FindFirst "CustomerID=" & rsOrder.Fields("CustomerID").Value
If rsCustomer.NoMatch Then
MsgBox "Could not find customer: '" & rsOrder.Fields("CustomerID").Value _
& "' from invoice number: " & sInvNo
Else
Me.Bookmark = rsCustomer.Bookmark
End If
rsCustomer.Close
End If
.Close
End With

Me!txtInvNo = ""
Me!cmdFindCust.Default = False
End Sub

Private Sub Form_Close()
'don't delete
End Sub

Private Sub Form_Current()
With Me
If IsNull(![CustomerID]) Then
DoCmd.GoToControl "ContactFirstName"
End If
End With
End Sub

Private Sub Form_Activate()
'Me![fsubOrder].Requery
End Sub

Private Sub m_frmPrintInvoice_Close()
'save details to transactions table
'when frmPrintInvoice closes, update Transaction table

With Me
If !fraPrintPreview = csPrint Then
'CVH 12/03/2004 It seems that we can write the same order many times to the Inventory Transaction table
'without entering duplicate records. So I've commented out the prompt below

'Dim strMsg As String
'Dim intMsgbox As Integer
'strMsg = "You are about to update the Inventory Transactions table" & vbCrLf
'strMsg = strMsg & "Do you want to continue?"
'intMsgbox = MsgBox(strMsg, vbYesNo + vbQuestion, "Print Invoice")
'If intMsgbox = vbNo Then
' Exit Sub
'Else
UpdateInventoryTransactions
'End If
End If
End With
End Sub

Private Sub New_Order_Click()
DoCmd.OpenForm FormName:="Orders", DataMode:=acFormAdd
End Sub

Private Sub Open_Till_Click()
OpenTill csComPort
End Sub

Private Sub Orders_Click()
On Error GoTo Err_Orders_Click
With fsubOrder
If .Form.RecordsetClone.RecordCount <= 0 Then
Exit Sub
End If
End With

If IsNull(Me![CustomerID]) Then
MsgBox "Enter customer information before entering order."
Else
If Me.Dirty Then
DoCmd.RunCommand acCmdSaveRecord
End If
Dim strCriteria As String
strCriteria = ""
If Not IsNull(Me!CustomerID) Then
strCriteria = "CustomerID = " & Me!CustomerID
End If
DoCmd.OpenForm FormName:="Orders", WhereCondition:=strCriteria
End If

Exit_Orders_Click:
Exit Sub

Err_Orders_Click:
MsgBox Err.Description
Resume Exit_Orders_Click
End Sub

Private Sub Payments_Click()
On Error GoTo Err_Payments_Click
Dim sCriteria As String

With fsubOrder
If .Form.RecordsetClone.RecordCount <= 0 Then
Exit Sub
End If
End With

If Me.Dirty Then
DoCmd.RunCommand acCmdSaveRecord
End If
sCriteria = "[OrderID]=" & [fsubOrder]![OrderID]
DoCmd.OpenForm FormName:="Payments", WhereCondition:=sCriteria
Exit_Payments_Click:
Exit Sub

Err_Payments_Click:
MsgBox Err.Description
Resume Exit_Payments_Click
End Sub

Private Sub PreviewCreditNote_Click()
On Error GoTo Err_PreviewCreditNote_Click
If Me.Dirty Then
DoCmd.RunCommand acCmdSaveRecord
End If
bRunStockUpdate = True
DoCmd.OpenReport "Invoice", acPreview, , "[OrderID] = " & [fsubOrder].Form![OrderID]

Exit_PreviewCreditNote_Click:
Exit Sub

Err_PreviewCreditNote_Click:
If Err <> 2501 Then
MsgBox Err.Description
End If
Resume Exit_PreviewCreditNote_Click
End Sub

Private Sub CatOrderButton_Click()
On Error GoTo Err_CatOrderButton_Click

Dim stDocName As String
Dim stLinkCriteria As String

stDocName = "CatCustomer"
DoCmd.OpenForm stDocName, , , stLinkCriteria

Exit_CatOrderButton_Click:
Exit Sub

Err_CatOrderButton_Click:
MsgBox Err.Description
Resume Exit_CatOrderButton_Click

End Sub

Private Sub CatalogueOrderBut_Click()
On Error GoTo Err_CatalogueOrderBut_Click

Dim stDocName As String
Dim stLinkCriteria As String

stDocName = "Catalogue Order"
DoCmd.OpenForm stDocName, , , stLinkCriteria

Exit_CatalogueOrderBut_Click:
Exit Sub

Err_CatalogueOrderBut_Click:
MsgBox Err.Description
Resume Exit_CatalogueOrderBut_Click

End Sub

Private Sub NextOrderbyCustomerBut_Click()
On Error GoTo Err_NextOrderbyCustomerBut_Click


DoCmd.GoToRecord , , acNext

Exit_NextOrderbyCustomerBut_Click:
Exit Sub

Err_NextOrderbyCustomerBut_Click:
MsgBox Err.Description
Resume Exit_NextOrderbyCustomerBut_Click

End Sub

Private Sub Next_Click()
On Error GoTo Err_Next_Click


DoCmd.GoToRecord , , acNext

Exit_Next_Click:
Exit Sub

Err_Next_Click:
MsgBox Err.Description
Resume Exit_Next_Click

End Sub

Private Function UpdateInventoryTransactions() As Long
'1 append the Order Details records to the Inventory Transactions table for the current order
'2 set the InventoryUpdated field in the OrderDetails table for the details of the current order

On Error GoTo UpdateInventoryTransactionsErr

Const csError = 65535
Const csZero = 0

Dim wks As Workspace
Dim db As Database
Dim strSQL As String
Dim strInsert As String
Dim strSelect As String
Dim strFrom As String
Dim strWhere As String
Dim strSaleOrReturn As String
Dim lngRetval As Long 'flag for error


If Me.ComparisonOperator = ">=" Then
strSaleOrReturn = " 'Sale:' & "
Else
strSaleOrReturn = " 'Return:' & "
End If

Set db = CurrentDb
Set wks = DBEngine.Workspaces(0)
wks.BeginTrans
'try to add records to Inventory Transactions table
strInsert = "INSERT INTO [Inventory Transactions] (TransactionDate, ProductID, TransactionDescription, UnitPrice, UnitsSold)"
strSelect = " SELECT #" & Date & "#, [Order Details].ProductID,"
strSelect = strSelect & strSaleOrReturn & "[Products].SerialNumber, [Order Details].UnitPrice, [Order Details].Quantity"
strFrom = " FROM [Order Details] INNER JOIN Products"
strFrom = strFrom & " ON [Order Details].ProductID = [Products].ProductID"
strWhere = " WHERE [OrderID]=" & Me.SelectedOrderID
strWhere = strWhere & " AND [InventoryUpdated]=FALSE"
strWhere = strWhere & " AND [Quantity]" & Me.ComparisonOperator & csZero

strSQL = strInsert & strSelect & strFrom & strWhere
#If csDebug = 1 Then
MsgBox "Inventory: " & vbCrLf & strSQL
#End If

lngRetval = RunActionQuery(db, strSQL) 'add records to Inventory Transactions table
If lngRetval = -1 Then 'error
Err.Raise Number:=csError, Description:="Could not update Inventory Transactions table"
Else 'now try to update Order Details table
strSQL = "UPDATE [Order Details] SET [InventoryUpdated]=TRUE"
strSQL = strSQL & strWhere
#If csDebug = 1 Then
MsgBox "Order Details: " & vbCrLf & strSQL
#End If
lngRetval = RunActionQuery(db, strSQL) 'update Order Details table
If lngRetval = -1 Then
Err.Raise Number:=csError, Description:="Could not update Order Details table"
End If
End If
UpdateInventoryTransactions = lngRetval

wks.CommitTrans
UpdateInventoryTransactionsExit:
Exit Function
UpdateInventoryTransactionsErr:
With Err
MsgBox .Description & ": " & .Number
End With
wks.Rollback
Resume UpdateInventoryTransactionsExit
End Function 'UpdateInventoryTransactions

'called from cmdDeliveryNote
Private Sub PrintDeliveryNote()
With Me
If !fraPrintPreview = csPrint Then
On Error GoTo CatchError
DoCmd.OpenReport reportName:="rptDeliveryNote", view:=acViewNormal
Else 'csPreview
On Error GoTo CatchError
DoCmd.OpenReport reportName:="rptDeliveryNote", view:=acViewPreview
End If
End With 'me

CatchError:
Exit Sub
End Sub 'PrintDeliveryNote()

'Called from cmdInvoice and cmdReturn.
Private Sub PrintInvoiceOrReturn(ByVal intChoice As Integer, strComparison As String)
'print/preview the Invoice report or the Return report
'args: intChoice is one of csInvoice or csReturn
' strComparison is one of '>=' or '<'

Dim lngOrderID As Long
Dim strCriteria As String
Dim lngRetval As Long
Dim lngOrderDetailCount As Long
Dim intMsgbox As Integer
Dim strMsg As String

lngOrderID = Me![fsubOrder]!OrderID
strCriteria = "[OrderID]=" & lngOrderID
'check that the order has one or more order details (or returns)
lngOrderDetailCount = DCount("OrderDetailID", "Order Details", "OrderID=" & lngOrderID & " AND [Quantity]" & strComparison & "0")

If lngOrderDetailCount <= 0 Then 'there are no sales lines (either orders or returns, depending on strComparison)
MsgBox "This invoice has no " & IIf(strComparison = ">=", "order details ", "returns ") & "to print"
Exit Sub
Else
If Me.Dirty Then
DoCmd.RunCommand acCmdSave
End If
End If

DoCmd.OpenForm FormName:="frmPrintInvoice", OpenArgs:="Comparison=" & strComparison
Set m_frmPrintInvoice = Forms!frmPrintInvoice
CatchError:
Exit Sub
End Sub 'PrintInvoiceOrReturn()

Private Sub PrintPickList()
With Me
If !fraPrintPreview = csPrint Then
On Error GoTo CatchError
DoCmd.OpenReport reportName:="rptPickList", view:=acViewNormal
Else 'csPreview
On Error GoTo CatchError
DoCmd.OpenReport reportName:="rptPickList", view:=acViewPreview
End If
End With 'me

CatchError:
Exit Sub
End Sub 'PrintPickList()

Private Sub Shop_Customer_Click()
FindShopCustomer
End Sub

Private Sub txtInvNo_Enter()
Me!cmdFindCust.Default = True
End Sub

Private Sub txtInvNo_Exit(Cancel As Integer)
Me!cmdFindCust.Default = False
End Sub

 

[greenfibres]

Any one able to help?

 

[dhookom]

I expect nobody wants to review all of your code. I know I won't.

You might want to take the time to prune your code to significant procedures only and provide some explaination of what you are attempting to do.

Duane MS Access MVP
[green]Ask a great question, get a great answer.[/green] [red]Ask a vague question, get a vague answer.[/red]
[green]Find out how to get great answers faq219-2884.[/green]

 

[greenfibres]

Hi Duane
I can appreciate that close scrutiny is too much to ask.
But, I guess there's maybe only one function in the code that trips up the solution that was given above - unfortunately I don't know enough to work that out. Although it does seem possibly related to a Bookmark function that's in there.
I have inherited this database that has coding I have no understanding of, but I still need to be able to date-stamp any changes.
What would you do in my place?
All the best
Jim

 

[SgtJarrow]

Jim,

You say your form does not have a BeforeUpdate event, so you need to add it. Duane's suggestion should still work in your case. You have already tested it and seen that it works...

OPen you form in design view, and on the top left is a little box-like area. This is the form selector. Click that and it should get a black center. Open your properties window, find the BeforeUpdate event. Set this to Event Procedure and click the little ellipse at the end of the property row. This should add the BeforeUpdate event to your form. Add Duane's suggestion and you should be golden...

=======================================
People think it must be fun to be a super genius, but they don't realize how hard it is to put up with all the idiots in the world. (Calvin from Calvin And Hobbs)

Robert L. Johnson III
CCNA, CCDA, MCSA, CNA, Net+, A+, CHDP
VB/Access Programmer

 

[dhookom]

Actually, the update code was from PH. My reply contained a suggestion unrelated to the actual question

Duane MS Access MVP
[green]Ask a great question, get a great answer.[/green] [red]Ask a vague question, get a vague answer.[/red]
[green]Find out how to get great answers faq219-2884.[/green]

 

[SgtJarrow]

My bad....both PHV and you deserve credit for your help here anyway.

=======================================
People think it must be fun to be a super genius, but they don't realize how hard it is to put up with all the idiots in the world. (Calvin from Calvin And Hobbs)

Robert L. Johnson III
CCNA, CCDA, MCSA, CNA, Net+, A+, CHDP
VB/Access Programmer

 

[greenfibres]

Hi Robert (& Duane & PH)
I have added the BeforeUpdate event and it works fine UNLESS the current record is exited via a search box that sits within the form.
Then it gives the following message
"Run-time error '3020':
Update or CancelUpdate without AddNew or Edit"
and if I click debug it takes me straight to the line
"Me![LastMod] = Now()"

Here's the short(ish) piece of code that precedes the BeforeUpdate event

Private Sub cmdFindCust_Click()
Dim rsOrder As Recordset
Dim rsCustomer As Recordset
Dim db As Database
Dim sInvNo As String

If IsNull(Me!txtInvNo) Or Me!txtInvNo = "" Then
MsgBox "Enter an invoice number to find"
Exit Sub
End If

Set db = CurrentDb()
Set rsOrder = db.OpenRecordset("Orders")
With rsOrder
sInvNo = Me!txtInvNo
.FindFirst "OrderID=" & sInvNo
If .NoMatch Then
MsgBox "Could not find invoice number: " & sInvNo
Else
Set rsCustomer = Me.RecordsetClone
rsCustomer.FindFirst "CustomerID=" & rsOrder.Fields("CustomerID").Value
If rsCustomer.NoMatch Then
MsgBox "Could not find customer: '" & rsOrder.Fields("CustomerID").Value _
& "' from invoice number: " & sInvNo
Else
Me.Bookmark = rsCustomer.Bookmark
End If
rsCustomer.Close
End If
.Close
End With

Me!txtInvNo = ""
Me!cmdFindCust.Default = False
End Sub

Private Sub Form_BeforeUpdate(Cancel As Integer)
Me![LastMod] = Now()
End Sub

I really appreciate your help so far
Jim

 

[SgtJarrow]

First thought would be that the error is related to the code trying to run with no real update...Your BeforeUpdate code may be kicking off unexpectedly.

I would think you only want to update the LastMod field if something on the record was changed. You can use the Dirty property of the form to help identify that...

Change your BeforeUpdate event to

If Me.Dirty Then
    Me![LastMod] = Now()
End If

And as I am typing this I realized you can probably use a different event, the OnDirty event, of the form instead of the BeforeUpdate. This event kicks off just before a record is updated...which is what I think you are trying to accomplish anyway.

=======================================
People think it must be fun to be a super genius, but they don't realize how hard it is to put up with all the idiots in the world. (Calvin from Calvin And Hobbs)

Robert L. Johnson III
CCNA, CCDA, MCSA, CNA, Net+, A+, CHDP
VB/Access Programmer

 

[greenfibres]

I changed the BeforeUpdate as suggested, but with the same result.

I can't find an OnDirty event in the properties...

To recap, I basically want to record the last date a record is modified. The solution given works, unless I exit the current record by using the search option as mentioned above in my previous post.
Somehow, exiting that way doesn't close the record in the same way as exiting through clicking next record, or from searching a field in the record.
Does that give any clues?
Thanks
Jim

 

[SgtJarrow]

What version of Access?

=======================================
People think it must be fun to be a super genius, but they don't realize how hard it is to put up with all the idiots in the world. (Calvin from Calvin And Hobbs)

Robert L. Johnson III
CCNA, CCDA, MCSA, CNA, Net+, A+, CHDP
VB/Access Programmer

 

[greenfibres]

Access 97

 

[SgtJarrow]

That might explain the OnDirty not being there...I think that was introduced in Access2000.

OK how about this? Instead of usng the BeforeUpdate event, let's consider your situation as two parts...You have a search box that allows you to move from record to record. If you use this box, there is an error in setting the LastMod field for the current record before you move to the new record. BUT, let's consider someone searching through several records and never making a change to any.....the LastMod date SHOULD NOT be updated anyway.

So, remove the entire BeforeUpdate event. Take the line

Me![LastMod] = Now()

and make it the VERY FIRST LINE in your code that SAVES the current record...I didn't look at all your code to know which part.

By doing this, the LastMod will only be updated as you click to save...It will not be executed when you are just moving through records.

=======================================
People think it must be fun to be a super genius, but they don't realize how hard it is to put up with all the idiots in the world. (Calvin from Calvin And Hobbs)

Robert L. Johnson III
CCNA, CCDA, MCSA, CNA, Net+, A+, CHDP
VB/Access Programmer

 

[greenfibres]

Thanks for your persistence, but no joy either.

 

[SgtJarrow]

Well, my last suggestion is to leave everything as you started with and at the END of the method that saves a record, call/execute a SQL command that updates the LastMod date independently...

something like:

DoCmd.ExecuteSQL("UPDATE table SET LastMod = #" & Now() & "# WHERE recordid = " & value)

Outside of that, you have exhausted my ideas...[frown]

=======================================
People think it must be fun to be a super genius, but they don't realize how hard it is to put up with all the idiots in the world. (Calvin from Calvin And Hobbs)

Robert L. Johnson III
CCNA, CCDA, MCSA, CNA, Net+, A+, CHDP
VB/Access Programmer