J
Jessica
I've converted a database over to MS 2007 and now when I run a function (see
below) it will run but lock down the database so that nothing can be saved.
I get the following error message:
Run-time error 3734: The database has been placed in a state by user 'Admin
on machine '' that prevents it from being opened or locked.
Can anyone tell me what is going wrong in 2007? This code functioned
perfectly in 2000 and 2003 versions. Below is the code. There are three
functions that I am running from the fourth (bottom) function. In addition
to locking the machine, it appears that the third function is never called
correctly as the updates do not occur.
Thanks
Jessica
Code:
Function NewFish()
Dim specs As Recordset
Dim fish As Recordset
Dim db As Database
Dim ID As String
DAO.DBEngine.SetOption dbMaxLocksPerFile, 30000
DBEngine.Idle dbFreeLocks
DBEngine.Idle dbRefreshCache
Set db = CurrentDb()
Set specs = db.OpenRecordset("tbl_TaggedSpecimens", dbOpenDynaset)
Set fish = db.OpenRecordset("tbl_TagID", dbOpenDynaset)
fish.Sort = "[FISH_ID]"
fish.MoveLast
ID = fish![FISH_ID]
fish.Edit
specs.Edit
Do Until specs.EOF
If IsNull(specs![FISH_ID]) Then
Select Case specs![disposition]
Case "1", "2", "4", "6"
specs.Edit
ID = ID + 1
specs![FISH_ID] = ID
specs.Update
If Not IsNull(specs![SH_Tag]) Then
fish.AddNew
SH = specs![SH_Tag]
fish![FISH_ID] = ID
fish![TagType] = "SH"
fish![Tag] = SH
fish.Update
End If
If Not IsNull(specs![ND_Tag]) Then
fish.AddNew
ND = specs![ND_Tag]
fish![FISH_ID] = ID
fish![TagType] = "ND"
fish![Tag] = ND
fish.Update
End If
If Not IsNull(specs![PIT_Tag]) Then
fish.AddNew
PIT = specs![PIT_Tag]
fish![FISH_ID] = ID
fish![TagType] = "PIT"
fish![Tag] = PIT
fish.Update
End If
End Select
End If
specs.MoveNext
Loop
fish.Close
specs.Close
Set db = Nothing
End Function
Function OldFish()
Dim specs As Recordset
Dim fish As Recordset
Dim db As Database
Dim ID As String
Dim msgstr As String
DAO.DBEngine.SetOption dbMaxLocksPerFile, 15000
DBEngine.Idle dbFreeLocks
DBEngine.Idle dbRefreshCache
Set db = CurrentDb()
Set specs = db.OpenRecordset("tbl_TaggedSpecimens", dbOpenDynaset)
Set fish = db.OpenRecordset("tbl_TagID", dbOpenDynaset)
specs.Edit
specs.MoveFirst
Do Until specs.EOF
specs.Edit
If IsNull(specs![FISH_ID]) Then
Select Case specs![disposition]
Case "3", "5", "6", "8"
If Not IsNull(specs![PIT_Tag]) Then
If Not IsNull(DLookup("[Fish_ID]", "tbl_TagID",
"[TagType] = 'PIT' and [tag] = '" & specs![PIT_Tag] & "'")) Then
ID = DLookup("[Fish_ID]", "tbl_TagID", "[TagType] =
'PIT' and [tag] = '" & specs![PIT_Tag] & "'")
specs![FISH_ID] = ID
specs.Update
End If
End If
End Select
End If
specs.MoveNext
Loop
specs.MoveFirst
Do Until specs.EOF
specs.Edit
If IsNull(specs![FISH_ID]) Then
Select Case specs![disposition]
Case "3", "5", "6", "8"
If Not IsNull(specs![ND_Tag]) Then
If Not IsNull(DLookup("[Fish_ID]", "tbl_TagID",
"[TagType] = 'ND' and [tag] = '" & specs![ND_Tag] & "'")) Then
ID = DLookup("[Fish_ID]", "tbl_TagID", "[TagType] =
'ND' and [tag] = '" & specs![ND_Tag] & "'")
specs![FISH_ID] = ID
specs.Update
End If
End If
End Select
End If
specs.MoveNext
Loop
specs.MoveFirst
Do Until specs.EOF
specs.Edit
If IsNull(specs![FISH_ID]) Then
Select Case specs![disposition]
Case "3", "5", "6", "8"
If Not IsNull(specs![SH_Tag]) Then
If Not IsNull(DLookup("[Fish_ID]", "tbl_TagID", "[TagType]
= 'SH' and [tag] = '" & specs![SH_Tag] & "'")) Then
ID = DLookup("[Fish_ID]", "tbl_TagID", "[TagType] =
'SH' and [tag] = '" & specs![SH_Tag] & "'")
specs![FISH_ID] = ID
specs.Update
End If
End If
End Select
End If
specs.MoveNext
Loop
specs.Close
Set db = Nothing
End Function
Function qryUpdates()
DoCmd.SetWarnings False
DoCmd.OpenQuery "aqry_ND_Tags"
DoCmd.OpenQuery "aqry_SH_Tags"
DoCmd.OpenQuery "aqry_PIT_Tags"
DoCmd.OpenQuery "uqry_ND_Tags"
DoCmd.OpenQuery "uqry_SH_Tags"
DoCmd.OpenQuery "uqry_PIT_Tags"
DoCmd.SetWarnings True
End Function
Function Update_TagIDs()
NewFish
OldFish
qryUpdates
End Function
below) it will run but lock down the database so that nothing can be saved.
I get the following error message:
Run-time error 3734: The database has been placed in a state by user 'Admin
on machine '' that prevents it from being opened or locked.
Can anyone tell me what is going wrong in 2007? This code functioned
perfectly in 2000 and 2003 versions. Below is the code. There are three
functions that I am running from the fourth (bottom) function. In addition
to locking the machine, it appears that the third function is never called
correctly as the updates do not occur.
Thanks
Jessica
Code:
Function NewFish()
Dim specs As Recordset
Dim fish As Recordset
Dim db As Database
Dim ID As String
DAO.DBEngine.SetOption dbMaxLocksPerFile, 30000
DBEngine.Idle dbFreeLocks
DBEngine.Idle dbRefreshCache
Set db = CurrentDb()
Set specs = db.OpenRecordset("tbl_TaggedSpecimens", dbOpenDynaset)
Set fish = db.OpenRecordset("tbl_TagID", dbOpenDynaset)
fish.Sort = "[FISH_ID]"
fish.MoveLast
ID = fish![FISH_ID]
fish.Edit
specs.Edit
Do Until specs.EOF
If IsNull(specs![FISH_ID]) Then
Select Case specs![disposition]
Case "1", "2", "4", "6"
specs.Edit
ID = ID + 1
specs![FISH_ID] = ID
specs.Update
If Not IsNull(specs![SH_Tag]) Then
fish.AddNew
SH = specs![SH_Tag]
fish![FISH_ID] = ID
fish![TagType] = "SH"
fish![Tag] = SH
fish.Update
End If
If Not IsNull(specs![ND_Tag]) Then
fish.AddNew
ND = specs![ND_Tag]
fish![FISH_ID] = ID
fish![TagType] = "ND"
fish![Tag] = ND
fish.Update
End If
If Not IsNull(specs![PIT_Tag]) Then
fish.AddNew
PIT = specs![PIT_Tag]
fish![FISH_ID] = ID
fish![TagType] = "PIT"
fish![Tag] = PIT
fish.Update
End If
End Select
End If
specs.MoveNext
Loop
fish.Close
specs.Close
Set db = Nothing
End Function
Function OldFish()
Dim specs As Recordset
Dim fish As Recordset
Dim db As Database
Dim ID As String
Dim msgstr As String
DAO.DBEngine.SetOption dbMaxLocksPerFile, 15000
DBEngine.Idle dbFreeLocks
DBEngine.Idle dbRefreshCache
Set db = CurrentDb()
Set specs = db.OpenRecordset("tbl_TaggedSpecimens", dbOpenDynaset)
Set fish = db.OpenRecordset("tbl_TagID", dbOpenDynaset)
specs.Edit
specs.MoveFirst
Do Until specs.EOF
specs.Edit
If IsNull(specs![FISH_ID]) Then
Select Case specs![disposition]
Case "3", "5", "6", "8"
If Not IsNull(specs![PIT_Tag]) Then
If Not IsNull(DLookup("[Fish_ID]", "tbl_TagID",
"[TagType] = 'PIT' and [tag] = '" & specs![PIT_Tag] & "'")) Then
ID = DLookup("[Fish_ID]", "tbl_TagID", "[TagType] =
'PIT' and [tag] = '" & specs![PIT_Tag] & "'")
specs![FISH_ID] = ID
specs.Update
End If
End If
End Select
End If
specs.MoveNext
Loop
specs.MoveFirst
Do Until specs.EOF
specs.Edit
If IsNull(specs![FISH_ID]) Then
Select Case specs![disposition]
Case "3", "5", "6", "8"
If Not IsNull(specs![ND_Tag]) Then
If Not IsNull(DLookup("[Fish_ID]", "tbl_TagID",
"[TagType] = 'ND' and [tag] = '" & specs![ND_Tag] & "'")) Then
ID = DLookup("[Fish_ID]", "tbl_TagID", "[TagType] =
'ND' and [tag] = '" & specs![ND_Tag] & "'")
specs![FISH_ID] = ID
specs.Update
End If
End If
End Select
End If
specs.MoveNext
Loop
specs.MoveFirst
Do Until specs.EOF
specs.Edit
If IsNull(specs![FISH_ID]) Then
Select Case specs![disposition]
Case "3", "5", "6", "8"
If Not IsNull(specs![SH_Tag]) Then
If Not IsNull(DLookup("[Fish_ID]", "tbl_TagID", "[TagType]
= 'SH' and [tag] = '" & specs![SH_Tag] & "'")) Then
ID = DLookup("[Fish_ID]", "tbl_TagID", "[TagType] =
'SH' and [tag] = '" & specs![SH_Tag] & "'")
specs![FISH_ID] = ID
specs.Update
End If
End If
End Select
End If
specs.MoveNext
Loop
specs.Close
Set db = Nothing
End Function
Function qryUpdates()
DoCmd.SetWarnings False
DoCmd.OpenQuery "aqry_ND_Tags"
DoCmd.OpenQuery "aqry_SH_Tags"
DoCmd.OpenQuery "aqry_PIT_Tags"
DoCmd.OpenQuery "uqry_ND_Tags"
DoCmd.OpenQuery "uqry_SH_Tags"
DoCmd.OpenQuery "uqry_PIT_Tags"
DoCmd.SetWarnings True
End Function
Function Update_TagIDs()
NewFish
OldFish
qryUpdates
End Function