DAO - .AddNew PK value

[DarrenBoyer]

I've been working on this concept for some time and once it's done my database is ready to be field tested at work. There isn't too much time pressure just the occasional, "why is this taking so long?" right now.

This is modified from MichaelRed's FAQ700-184. However, once it was running correctly it still wasn't updating the CustomerID field when I wanted to create a new record. My code modifications to implement CustomerID field update are in bold. My idea was to perform the action on an event such as BeforeUpdate even though the original code was written as a function. At this point I'm very open to suggestions.

Function Custom_Counter()
(Was Public Sub Custom-Counter) [b/]
On Error GoTo Custom_Counter_Err

Dim NextAvailableCustomerID As Long
Dim db As DAO.Database
Dim BaseData As DAO.Recordset
Dim tblCounterTable As DAO.Recordset
Dim qMaxCustID As DAO.Recordset
Dim Customers As DAO.Recordset

Const RiErr = 3000
Const LockErr = 3260
Const InUseErr = 3262
Const NumReTries = 20#

'Variables for the Retry Counts
Dim NumLocks As Integer
Dim lngX As Long

'Variables Used in the Code
Dim NextAvailableCounter As Long
Dim lngOldCustomerID As Long
Dim lngNewCustomerID As Long
Dim lngBigCustomerID As Long
Dim CustomerID As Long

Set db = CurrentDb()
Set qMaxCustID = db.OpenRecordset("qMaxCustID", dbDenyRead)
Set BaseData = db.OpenRecordset("Customers")
Set tblCounterTable = db.OpenRecordset("tblCounterTable", dbDenyRead)
Set Customers = db.OpenRecordset("Customers", dbAppendOnly)

lngOldCustomerID = qMaxCustID!CustomerID
lngNewCustomerID = tblCounterTable!NextAvailableCounter 'C
lngBigCustomerID = lngNewCustomerID 'Big=C
If (lngOldCustomerID > lngBigCustomerID) Then
lngBigCustomerID = lngOldCustomerID
End If

If (NextAvailableCounter > lngBigCustomerID) Then
lngBigCustomerID = NextAvailableCounter
End If

'Increment the ID
lngBigCustomerID = lngBigCustomerID + 1
lngBigCustomerID = CustomerID

'Update the ID Value
With tblCounterTable
.Edit
!NextAvailableCounter = lngBigCustomerID
.Update
End With

With Customers
.AddNew
!CustomerID = lngBigCustomerID
.Update
End With

MsgBox "Next Available Counter is " & Str(lngBigCustomerID)

lngNewCustomerID = lngBigCustomerID
NormExit:
Set BaseData = Nothing
Set db = Nothing

Exit Function 'Return

Custom_Counter_Err:

'Check For the expected errors
If ((Err = InUseErr) Or (Err = LockErr) Or (Err = RiErr)) Then

'If one of the expected ones, increment the counter
NumLocks = NumLocks + 1

If (NumLocks < NumReTries) Then
For lngX = 1 To NumLocks ^ 2 * Int(Rnd * 20 + 5)
DoEvents
Next lngX
Resume Next
Else
End If
Else
MsgBox "Error" & Err.Number & ": " & Err.Description, _
vbOKOnly & vbCritical, "Get CustomerID"
GoTo NormExit
End If

End Function

 

[Golom]

Your problem is probably here
[blue][tt]
lngBigCustomerID = lngBigCustomerID + 1
lngBigCustomerID = CustomerID
[/tt][/blue]
After goung to all the effort in the preceding lines to set lngBigCustomerID, you then set it to CustomerID but that is not initialized and is therefore zero.

 

[DarrenBoyer]

I see the obvious logic error - that was dumb.

However, I changed it to what I thought was obvious.
CustomerID = lngBigCustomerID

And still got the same Error:3251 Operation is not supported for this type of object.

I'm trying to think this through and do the research but can't quite connect the dots right now.

 

[Golom]

I think that you've missed a parameter when you opened the recordset. It should be
[blue][tt]
Set Customers = db.OpenRecordset("Customers", dbOpenDynaset, dbAppendOnly)
[/tt][/blue]

 

[DarrenBoyer]

Golom,

Thank you very, very much. I'm sure this function is operating properly as it is now giving me an error that another field is Null (validating my field validation rules.)

Your help allowed me to take a step back and think about what has to happen next.

I believe that I need to call this function in an event like form is Dirty and the field value is empty. So I sat down and read through the books that I have and came up with this code:

[blue]Private Sub Form_Dirty(Cancel As Integer)
On Error GoTo Err_Form_Dirty

If IsEmpty(Me.CustomerID.Value) Then
Call Custom_Counter
Else
End If

Err_Form_Dirty:
MsgBox Err.Description
Resume Exit_Form_Dirty
End Sub [/blue]

The bold code is where my compile errors come up. So I don't mean to misuse anyone's time but am I on the right track?

 

[PHV]

Resume Exit_Form_Dirty
Where is the Exit_Form_Dirty label ?

Hope This Help, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884

 

[DarrenBoyer]

PHV,

Thank you for your response.

Where is the Exit_Form_Dirty label

would definitely produce an error. I had tried numerous variations on this and ended up posting that in error.

If I take the error msg code out and just post:

Private Sub Form_Dirty(Cancel As Integer)
On Error GoTo Err_Form_Dirty

If IsEmpty(Me.CustomerID.Value) Then
Call Custom_Counter
Else
End If

The procedure still isn't called up. However, my tblCounterTable increments everytime I compile. Is my methodology on the right track?

 

[PHV]

Try something like this:
Private Sub Form_Dirty(Cancel As Integer)
On Error GoTo Err_Form_Dirty
If IsEmpty(Me.CustomerID.Value) Then
Call Custom_Counter
End If
Exit Sub
Err_Form_Dirty:
MsgBox "Error" & Err.Number & ": " & Err.Description _
, vbOKOnly & vbCritical, "Form_Dirty"
End Sub


Hope This Help, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884

 

[DarrenBoyer]

Thnaks PHV,

This code compiles fine and goes through the debugger ok but still fails to add the value of lngBigCustomerID to the Customer ID field of a new record. I thought if I tried the bookmark command it may be the missing link but it's not at least the way I've used it. There's a logic error somewhere...

I'm going to repost the code just so the final copy is in one concise location.

My Event is as PHV outlined:

[blue]Private Sub Form_Dirty(Cancel As Integer)
On Error GoTo Err_Form_Dirty

If IsEmpty(Me.CustomerID.Value) Then
Call Custom_Counter
End If

Err_Form_Dirty:
MsgBox "Error Bad!" & Err.Number & ": " & Err.Description _
, vbOKOnly & vbCritical, "Form_Dirty"
End Sub [/blue]

My function is as follows. The new code for the bookmark command is in bold:

[blue]Function Custom_Counter()

On Error GoTo Custom_Counter_Err

Dim NextAvailableCustomerID As Long
Dim db As DAO.Database
Dim BaseData As DAO.Recordset
Dim tblCounterTable As DAO.Recordset
Dim qMaxCustID As DAO.Recordset
Dim Customers As DAO.Recordset

Const RiErr = 3000
Const LockErr = 3260
Const InUseErr = 3262
Const NumReTries = 20#

'Variables for the Retry Counts
Dim NumLocks As Integer
Dim lngX As Long

'Variables Used in the Code
Dim NextAvailableCounter As Long
Dim lngOldCustomerID As Long
Dim lngNewCustomerID As Long
Dim lngBigCustomerID As Long
Dim CustomerID As Long

'New Variables
Dim vntPosition As Variant

Set db = CurrentDb()
Set qMaxCustID = db.OpenRecordset("qMaxCustID", dbDenyRead)
Set BaseData = db.OpenRecordset("Customers")
Set tblCounterTable = db.OpenRecordset("tblCounterTable", dbDenyRead)
Set Customers = db.OpenRecordset("Customers", dbOpenDynaset, dbAppendOnly)

'New Addition
vntPosition = BaseData.Bookmark

lngOldCustomerID = qMaxCustID!CustomerID
lngNewCustomerID = tblCounterTable!NextAvailableCounter 'C
lngBigCustomerID = lngNewCustomerID 'Big=C
If (lngOldCustomerID > lngBigCustomerID) Then
lngBigCustomerID = lngOldCustomerID
End If

If (NextAvailableCounter > lngBigCustomerID) Then
lngBigCustomerID = NextAvailableCounter
End If

'Increment the ID
lngBigCustomerID = lngBigCustomerID + 1
CustomerID = lngBigCustomerID

'Update the ID Value
With tblCounterTable
.Edit
!NextAvailableCounter = lngBigCustomerID
.Update
End With

'Move Back to the Bookmarked row
BaseData.Bookmark = vntPosition

With Customers
.AddNew
!CustomerID = lngBigCustomerID [red] 'I want this to work so bad! [/red]
.Update
End With

MsgBox "Next Available Counter is " & Str(lngBigCustomerID)

lngNewCustomerID = lngBigCustomerID
NormExit:
Set BaseData = Nothing
Set db = Nothing

Exit Function 'Return

Custom_Counter_Err:

'Check For the expected errors
If ((Err = InUseErr) Or (Err = LockErr) Or (Err = RiErr)) Then

'If one of the expected ones, increment the counter
NumLocks = NumLocks + 1

If (NumLocks < NumReTries) Then
For lngX = 1 To NumLocks ^ 2 * Int(Rnd * 20 + 5)
DoEvents
Next lngX
Resume Next
Else
End If
Else
MsgBox "Error" & Err.Number & ": " & Err.Description, _
vbOKOnly & vbCritical, "Get CustomerID"
GoTo NormExit
End If

End Function [/blue]

When I try to create a new record I get the MsgBox With Error:0. I would appreciate any suggestions.

 

[DarrenBoyer]

I never did get this solution running. However, I bought the Access 2002 Developer's Handbook series and used the solution included in it. It is very similar but seems a little more bullet proof in design.

 

[James529]

Well, why not post the solution you came up with rather than leave us dangling on the solution?

 

[RoyVidar]

Because the authors of that book needs to earn a living, therefore the term "copyright" applies to their work - so to get at that solution, you need to buy it yourself;-)

Roy-Vidar