Forum Home
Press F1
 
Thread ID: 125929 2012-07-27 21:54:00 Access 2007 VBA/ADO coding problem Tony (4941) Press F1
Post ID Timestamp Content User
1291147 2012-07-27 21:54:00 I am in the process of stumbling through converting an application from DAO to ADO, and of course I am making mistakes which cause the app to halt. No problem, I'm working my way through them. However one result is that often I try to restart the app and I get the " database locked" message shown in the attachment. Questions:

(a) What is likely to be causing it? I never saw anything like it with DAO.
(b) Is there something I can do to stop the database being locked like this? The only solution I have found is to close Access and restart, which is a PITA.

In the screenshot, "SetDefaults" is the name of the routine that executes when the app first starts.

4032 		Tony (4941)
1291148 2012-07-28 00:19:00 It would be interesting to see the code but regardless you need to trap any errors like that so that you can make it exit gracefully.
At a guess you have a primary field and you are trying to re-enter the same data. 		mikebartnz (21)
1291149 2012-07-28 01:17:00 This only happens when the app has stopped abnormally for other reasons (like, I ' ve stuffed something up in my coding), and I try to restart it. I did read something somewhere that said that something had been left " open " , and I inferred it was the ADO connection - which would probably be the case if the app has stopped abnormally. However I can ' t work out how to close it. If I try to do it in the immediate window it either says an object is required, or appears to work but makes no difference to the message appearing.

This is the module that is executing - not where any error occurred. It ' s a bit of a dog ' s breakfast atm as I ' m trying to keep the original code while adding the ADO code.



Function SetDefaults(frmname As String, AppStart As Boolean)
'
' Load all default values
' Called splash form and frmEditDefaults
'
On Error GoTo err_label

' +++++++++++++++++++++++++++++++++++++++++ '
' '
' ADO Declarations '
' '
' +++++++++++++++++++++++++++++++++++++++++ '

Dim cnn As ADODB.Connection

' +++++++++++++++++++++++++++++++++++++++++ '

' Dim rstDefaults As Recordset
' Dim rstTableLogo As Recordset

Dim rstDefaults As ADODB.Recordset
Dim rstTableLogo As ADODB.Recordset

Dim LogoPath As String

If AppStart Then
' MsgBox " startup... "
boolAppStart = True

Else
boolAppStart = False
End If

' +++++++++++++++++++++++++++++++++++++++++ '

Set cnn = New ADODB.Connection
cnn.Open " Provider=Microsoft.ACE.OLEDB.12.0; " & _
" User ID=Admin; " & _
" Persist Security Info=False; " & _
" Data Source= " & CurrentProject.Path & _
" \ADMINV8_1_0.mdb; "
' +++++++++++++++++++++++++++++++++++++++++ '

' Set rstTableLogo = CurrentDb.OpenRecordset( " tblLogoName " )
Set rstTableLogo = New ADODB.Recordset
rstTableLogo.Open ( " tblLogoName " ), cnn
' +++++++++++++++++++++++++++++++++++++++++ '

If rstTableLogo.EOF Then
Call SystemError( " startup " , " logofile table is empty " )
MsgBox " Application cannot continue - closing down "
DoCmd.Quit
Else
rstTableLogo.MoveFirst
LogoPath = Nz(rstTableLogo!logoid, " " )
If IsNothing(rstTableLogo!logoid) Or _
(Len(Dir(LogoPath))) = 0 Then
If MsgBox( " The logo image files can ' t be found - do you want to update the location? " , vbQuestion + vbYesNo, " No logo images " ) = vbYes Then
If Not boolAppStart Then
Call GoForward( " switchboard " )
End If
DoCmd.OpenForm " frmupdatelogoimage " , , , , , acDialog
Else
MsgBox " Application cannot continue - closing down "
DoCmd.Quit
End If
End If
rstTableLogo.Close
End If

lbl_LinksFixed:

' +++++++++++++++++++++++++++++++++++++++++ '
' Set rstDefaults = CurrentDb.OpenRecordset( " tblDefaultValues " )
Set rstDefaults = New ADODB.Recordset
rstDefaults.Open ( " tblDefaultValues " ), cnn
' +++++++++++++++++++++++++++++++++++++++++ '

If rstDefaults.EOF Then
With rstDefaults
.AddNew
!dfltTermLength = 0
!dfltMaxClassSize = 0
!dfltMinEnrolment = 0
!dfltCourseCost = 0
!dfltEmailChunk = 1
!dfltEmailDelay = 0
!dfltSignature = " "
.Update
End With
rstDefaults.MoveFirst
End If

intDefaultTermLength = Nz(rstDefaults!dfltTermLength, 0)
intDefaultMaxClassSize = Nz(rstDefaults!dfltMaxClassSize, 0)
intMinEnrolment = Nz(rstDefaults!dfltMinEnrolment, 0)
curCourseCost = Nz(rstDefaults!dfltCourseCost, 0)
intDefaultEmailChunk = Nz(rstDefaults!dfltEmailChunk, 1)
lngDefaultEmailDelay = Nz(rstDefaults!dfltEmailDelay, 0)
txtDefaultSignature = Nz(rstDefaults!dfltSignature, " " )

rstDefaults.Close

pubstrThisYear = DatePart( " yyyy " , Date)

ReDim pubEmailAttachment(1) ' make sure the array is initialized

boolDefaultsLoaded = True
If AppStart Then
If IsLoaded( " frmupdatelogoimage " ) Then DoCmd.Close acForm, " frmupdatelogoimage "
DoCmd.OpenForm ( " splash " )
End If
' ++++++++++++++++++++++++++++++++++++ '
cnn.Close
Set cnn = Nothing
' ++++++++++++++++++++++++++++++++++++ '
Exit Function

err_label:
Select Case Err.Number
Case 3024, 3044 ' file not found
Call linkerror(frmname)
Resume lbl_LinksFixed
Case Else
MsgBox " Set Defaults error: " & Err.Number & " " & Err.Description
End Select

End Function 		Tony (4941)
1291150 2012-07-28 01:47:00 Trap the error number in your err_label: routine and have it disconnect from the DB.
That error number is as I said before so I think it may be happening at this point
If rstDefaults.EOF Then
With rstDefaults
.AddNew
The check of EOF can't be working properly so it is trying to add data when it already has that same data there.
It is too long since I had anything to with Access which I never did like so sorry I can't help more. 		mikebartnz (21)
1291151 2012-07-28 02:18:00 Thanks Mike. I'll give that a go. I've just found out from another forum that ADO is being deprecated, much to the annoyance of many people, so maybe the problem will solve itself and I can go back to DAO! Tony (4941)
1