Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Westi on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

How to set DAO database to a string?

Status
Not open for further replies.

Larsson

Programmer
Jan 31, 2002
140
SE
Hi all!

I am trying to implement the generate autonumber function from faq700-184 and I have some problems.

First, is this possible to do in ADO?

If not how do I set my database to another database then the current database (CurrentDB())?
I have tried with:

Dim dbm As DAO.Database
Set dbm = “C:\Database\database1.mdb”

And I get the following debug error: “Type mismatch”

Any and all help is appreciated, Larsson



Here is the function:

Public Function NewQI_Num() As Long

'Submiitted to Tek-Tips.Com as Access FAQ on generating Unique ID numbers
'in a Multi-User database. This example Function was adapted from a commercial
'applilcation with approximatly 50 concurrent users and was in-service for over
'a year with out "Timing-Out" with the Retry value of 20.

'MichaelRed 8/15/2000.
'There is Never time to do it right but there is always time to do it over

On Error GoTo NewQiNum_Err

Dim MyDbs As Database 'Substitute Your Database Name Here
Dim BaseData As Recordset
Dim tblNewQiNum As Recordset
Dim qSelQiMax As Recordset

'Constants for the expected errors
Const RiErr = 3000
Const LockErr = 3260
Const InUseErr = 3262
Const NumReTries = 20# 'This is just a number of attempts
'we will make internally to this Function
'it is set to a nominal value, which works
'for moderate (~ 50 Users). It could be set
'to any arbitrary value, however the
'expectation it that it will NEVER Fail

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

'Variables used in the Code.
'Not that this implementation "wants" part of the Date (Year & Month)
' to be "Encoded" in the Unique Id, otherwise we could dispense with
'most of these vars - and there use/calculation below
Dim QiNum As Long
Dim lngOldQiNum As Long
Dim lngNewQiNum As Long
Dim lngBigQiNum As Long
Dim QiYear As Long
Dim QiMnth As String
Dim strQINum As String

'Remember to Use your DataBase Name
Set MyDbs = CurrentDb()
Set BaseData = MyDbs.OpenRecordset("Basic Data")

'Get the date part of the Id
QiYear = Format(Now, "yyyy")
QiMnth = Format(Now(), "mm")
strQINum = QiYear & QiMnth

'Get the Lowest possible value for an ID for the current Date
'This is a good place to remind everyone that all of the
'System (e.g. individual computer) Clocks MUST be synchronized!!!!
'the const vlaue (1000) is selected as a number >> the number of
'ID's we expect in the time period before Resetting the Prefix (e.g. Monthly)
QiNum = Val(strQINum) * 10000 'B

'For the convienience of readers the SQl from the Query is given
'Again, please be careful to use YOUR recordset (name)
'SELECT Max([Basic Data].Qi) AS Qi FROM [Basic Data];

'Get the Currently assigned Highest value. Again, this is only
'necessary because this implememtation 'wants the year & month in the Stamp
'Also, note the dbDenyRead. This assures us that - if we get access to the info,
'We have SOLE access to it. No one else can get past here untill we are done.
Set qSelQiMax = MyDbs.OpenRecordset("qSelQiMax", dbDenyRead)
Set tblNewQiNum = MyDbs.OpenRecordset("tblNewQiNum", dbDenyRead)

'tblNewQiNum has only two fields, [QiNum] & [QiDateTime].
'It only has a single record, so when we open the recordset, we are on
'the first record, and these values are immediatly available

'Again, this - except for the incrementing below - is just ot incorporate
'the Year and Month into the value as a Prefix.
lngOldQiNum = qSelQiMax!QI 'A
lngNewQiNum = tblNewQiNum!QiNum 'C
lngBigQiNum = lngNewQiNum 'Big = C (Assume C is the Answer)
If (lngOldQiNum > lngBigQiNum) Then 'IF (A >= Big) Then
lngBigQiNum = lngOldQiNum ' Big = A
End If 'End If

If (QiNum > lngBigQiNum) Then 'If (B >= Big) Then
lngBigQiNum = QiNum ' Big = B
End If 'End If

'Increment the ID
lngBigQiNum = lngBigQiNum + 1


'Update the Id value and (just for my own interest) the date/time stamp
With tblNewQiNum
.Edit
!QiNum = lngBigQiNum
!QiDateTime = Now()
.Update
End With
NewQI_Num = lngBigQiNum

NormExit:
Set BaseData = Nothing
Set MyDbs = Nothing

Exit Function 'Return

NewQiNum_Err:

'This is the part where we wait if another user is getting a New ID

'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 'Check for to many attempts
'Failing here probably indicates
'a system problem, not a real &quot;TimeOut&quot;

'We generate a pseudo random value to use in the empty loop
'it's really just a (pseudo) ramdom interval thinnnggggggyyyyyy
For lngX = 1 To NumLocks ^ 2 * Int(Rnd * 20 + 5)
DoEvents 'Wait in La-La land
Next lngX
Resume Next 'Go Back and Try Again
Else
'This should not happen. 20 Random retries should always
'get a unique number. But here is where the error handler would go
End If
Else
'Unexpected Error - Also known as &quot;Tell me the Story, the old, old story ...
MsgBox &quot;Error &quot; & Err.Number & &quot;: &quot; & Err.Description, _
vbOKOnly & vbCritical, &quot;Get Qi Number&quot;
Go To NormExit
End If

End Function
 
If you want to connect to a database using ADO you need something like...

'Dim connection
Public gcnnDB As New ADODB.Connection

'Open Connection
Public Sub gConnectDB()

gcnnDB.Open &quot;Driver={Microsoft Access Driver (*.mdb)};&quot; & _
&quot;Dbq=Z:\Lottery\Lottery.mdb;&quot; & _
&quot;Uid=admin;&quot; & _
&quot;Pwd=&quot;

End Sub

'Use Connection

Dim rstLine As New ADODB.Recordset

rstLine.Open &quot;tblBall&quot;, gcnnDB, adOpenStatic, adLockOptimistic, adCmdTable


This is VB6 code but should work in Access.

There are two ways to write error-free programs; only the third one works.
 
Okej, but can I then open the recordset in a DenyRead mode, as it is done in the function:

Set qSelQiMax = MyDbs.OpenRecordset(&quot;qSelQiMax&quot;, dbDenyRead)

Larsson
 
We are talking apples and oranges here. First of all the code Larsson is referencing is Data Access Object (DAO) and is totally separate from Access because it is implemented using dao360.dll, which listed in the references or used by default in Access 97 and earlier. ADO also is separate from Access and is used by default in Access 2000 or greater. Each have their advantages. There is a CursorType property in ADO recordsets which allow you to set the cursor as adOpenDynamic, adOpenForwardOnly, adOpenKeyset, or adOpenStatic but these are not exactly the same as the DAO dbDenyRead property.



----------------------
scking@arinc.com
Life is filled with lessons.
We are responsible for the
results of the quizzes.
-----------------------
 
So if I understand you correctly, there is no corresponding way with ADO to open recordset in deny read mode.

Larsson
 
As far as I know ADO has no way to lock the whole table. The closest is locking the current record as soon as you open it for editing using adLockPessimistic.

There are two ways to write error-free programs; only the third one works.
 
Since the table which holds the current value has only the single record, you can use the edit ... pessimistic lock. You can also have / include both ADO and DAO recordsets in an app, so the code can also work &quot;as is&quot;, simply by adding the DAO 3.6 library as a reference and prepending &quot;DAO.&quot; to the db as rs declarations. You will, hoeever, need to be careful and apply &quot;DAO.&quot; to only the specific db and rs declarations which deal w/ the semiautonumber db & rs.


MichaelRed
m.red@att.net

There is never time to do it right but there is always time to do it over
 
Yes, but then we get back to my other question.

I get this error messeage &quot;Type mismatch&quot;, when Access compile the following lines:

Dim dbm As DAO.Database
Set dbm = “C:\Database\database1.mdb”

What is wrong?
Larsson
 
syntax


Set dbm = “C:\Database\database1.mdb”

Should be something else, similar to:

Set dbm = Opendatabase(“C:\Database\database1.mdb”)

MichaelRed
m.red@att.net

There is never time to do it right but there is always time to do it over
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top