Run-Time Error 3734



I am trying to make some code work and I get the following Visual Basic error:

Run-Time Error 3734
Database has been placed in a state by user "Admin" On Machine "Computer"
that prevents it from being opened or locked.

I have been stripping down the code I am running and I think I have found
the culprit. When testing different lines in the immediately window, and
using this part of the code "Set dbs = CurrentDb" I can recreate the error
message I get when I attempt to run the code. Why would I get this error?

The following is the stripped down code I am running:

Private Sub Command8_Click()

Dim dbs As DAO.Database
Dim wrk As DAO.Workspace
Dim strSQL As String, strQuery As String, strMessage As String

strSQL = "UPDATE tblTimerDate SET LastTimerDate = " & _
Format(Date, "\#mm/dd/yyyy\#")

On Error GoTo Err_Handler

If Time() > #6:30:00 AM# Then

If DLookup("LastTimerDate", "tblTimerDate") < Date Then

Set wrk = DAO.DBEngine.Workspaces(0)
Set dbs = CurrentDb

' Appends Rx table to RX1 table "Adds new RX's to RX1 table"
strQuery = "1Append Rx to RX1 Query"
dbs.Execute strQuery, dbFailOnError

End If
End If

Exit Sub

strMessage = Error & vbNewLine & vbNewLine & _
"(Error in " & strQuery & ")" & _
vbNewLine & vbNewLine & "Transaction rolled back and no tables
MsgBox strMessage, vbExclamation, "Error"

Resume Exit_Here

End Sub



Nikos Yannacopoulos


I haven't checked your code thoroughly, but suspect the problem might be
coming from the fact that you do not reset your dbs object at the end of
your code, like:

Set dbs = Nothing

Which might be giving you the problem from the *second* time on you run
the code (or any piece of code that creates a database object of the
same name). Is this the case?

Also, you are creating (and not resetting) a workspace object that you
do not use; suggest you remove it altogether.




Adding Set dbs = Nothing, prevented the error but when I run the code,
nothing seems to fire. The code is supposed to look at a table to see if the
date is less than todays date and then if it is. and if it is 6:30 A M or
later the append query should fire. But as I say nothing fires? What do you


Nikos Yannacopoulos


I suppose you added the extra line of code right after the Exit_Here
label, before the Exit Sub, right?

Are your Windows regional settings non-US? If yes, you should format the
Date argument in your DLookup comparison like you did for the strSQL
construction, i.e.

If DLookup("LastTimerDate", "tblTimerDate") < Format(Date,
"\#mm/dd/yyyy\#") Then
(all in one line, watch out for wrapping!)

Also, the strQuery expression doesn't look correct for an executable SQL
expression, whereas the strSQL one at the beginning does, but you are
not executing it! Something gone wrong here?

One suggestion is to temporarily comment out the
On Error GoTo Err_Handler
line, so you get the exact error message at the line it occurs on.

Another sugestion is to run your code line by line (by presing F8) so
you see how it branches: if the problem is the date format, the If block
won't be executed at all, and execution will branch directly to Set dbs
= Nothng / Exit Sub; if the If block is executed, my best guess is you
will get an error relating to the strQuery expression.

That said, what is this expression? Did I guess correctly that the aim
was to run the strSQL expression instead?


Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question