Multiuser - Add New Records

[DarrenBoyer]

I'm probably going to cringe when I see the solution to this but I need to ask for help anyway.

I'm very new to coding but having a blast learning. Lately I have been consumed trying to implement MichaelRed's FAQ 700-184.

I'm using Access 2003 but thought I liked what I read enough to want to try and figure out this approach even thought it was DAO.

I beleive I've modified the code properly but now am having a real issue trying to have the CustomerID value updated when a user try's to start a new record. (The table has 5300 existing Customer's imported with a Customer ID.) I thought the BeforeUpdate Event was the right approach but when that didn't work I tried other events until I came to the conclusion I don't know how to get the job done right now.

Here's my modification which compiles fine:
Public Function CustomerID_Current()

On Error GoTo Custom_Counter_Err

Dim NextAvailableCustomerID As Long
Dim db As DAO.Database
Dim BaseData As Recordset
Dim tblCounterTable As Recordset
Dim qSelCustomerIDMax As 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

Set db = CurrentDb()
Set BaseData = db.OpenRecordset("Customers")

Set tblCounterTable = db.OpenRecordset("tblCounterTable", dbDenyRead)

lngBigCustomerID = tblCounterTable!NextAvailableCounter 'C

'Increment the ID
lngBigCustomerID = lngBigCustomerID + 10

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

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

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

 

[DarrenBoyer]

Wanted to refresh post to see if anyone had any suggestions.

 

[Paulsco]

Sorry I didn't have time to read all this code (or try it out) but something is obvious from the first few lines:

If your working with DAO you should dim/instantiate the recordset objects as DAO.Recordset as well otherwise Access can and does assumes ADO and your code will fail for a reason that is not abundantly clear.

Hope that helps and I'll try to look agian later.

 

[DarrenBoyer]

Thanks for your reply. You're right I redid the code this morning and kicked myself for having so many errors. There was a lot more wrong than the DAO part.

I'll post the updated code portion below but I know it's working because my MsgBox comes up with the correct Count and my seperate table with one field and one record named NextAvailableCounter has continously been updating everytime I run the code in VBE.

Now I need to have this function run and the value that is in the NextAvailableCounter field transfer to my CustomerID field in the Customers table. Of course this is done when a user try's to start a new record in my my form. How is this done? I'm not quite sure where to go looking right now.

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

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)

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

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

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

 

[DarrenBoyer]

I've tried to add the DAO cmds .AddNew & .LastModified to this project. Seems like the right way to go. However, I'm still stuck tryng to get the value the original function produces into my CustomerID field.

Anyone notice where I've missed something? Code changes are in bold.

Private Sub CustomerID_BeforeUpdate()

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)

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

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

'AddNew NextAvailableCounter value to the CustomerID field
With Customers
.AddNew
!NextAvailableCounter = CustomerID
.Update

'Move to the row just added
.Bookmark = .LastModified

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

Exit Sub '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 Sub

 

[DarrenBoyer]

I missed one line:

Set Customers = db.OpenRecordset("Customers", dbAppendOnly)

Now I'm getting an error 3251: Operation is Not Supported for this type of Object. It Complies fine though.