Background: SharePoint linked table is being updated by a form which calls code module in the beforeupdate event.
Desired End Result: When field in record changes to a value different than existing and not "GREEN", populate "Date Started" field with current date for tracking purposes.
Problem: When change is made that fits criteria, error returned is "Could not update; currently locked.". Have attempted workarounds described here ("http://support2.microsoft.com/kb/331594") to no avail. I've tried various things and am now running out of ideas for an "easy" fix.
As I understand, the form and code module are both attempting to update the same record and thus it is becoming locked. I was curious if there is a method of passing the information from the form transaction, cancelling, and then passing said information to the transaction occurring in the code. Please, let me know what the best way I can do this would be or if the below code is salvageable. I am relatively new to VBA so please excuse my lack of comments. If I get it to work, that will be my next step. Thank you. Credit goes to Martin Green (www.fontstuff.com) for the code structure which I followed from his tutorial and have now tailored for other purposes.
Code:
Option Compare Database
Sub AuditChanges(IDField As String)
On Error GoTo AuditChanges_Err
Dim conn As ADODB.Connection
Dim ctrl As Control
Dim rst As ADODB.Recordset
Dim datCheck As Date
Dim newvalue As String
Dim ctrlsource As String
Set conn = CurrentProject.Connection
conn.CursorLocation = adUseClient
Set rst = New ADODB.Recordset
rst.Open "SELECT * FROM [Table Name] WHERE [_ID] = " & (Screen.ActiveForm.Controls(IDField).Value) & "", conn, adOpenDynamic, adLockOptimistic
datCheck = DateValue(Now)
For Each ctrl In Screen.ActiveForm.Controls
If ctrl.Tag = "Audit" Then
If Nz(ctrl.Value) <> Nz(ctrl.oldvalue) And Nz(ctrl.Value) <> "GREEN" Then
With rst
' newvalue = Nz(ctrl.Value)
'ctrlsource = ctrl.ControlSource
'Screen.ActiveForm.RecordLocks = 0
.Fields("Date Started") = datCheck
'.Fields(ctrlsource) = newvalue
.Update
End With
End If
End If
Next ctrl
AuditChanges_Exit:
On Error Resume Next
conn.Close
Set rst = Nothing
Set conn = Nothing
Exit Sub
AuditChanges_Err:
MsgBox Err.Description, vbCritical, "ERROR!"
Resume AuditChanges_Exit
End Sub