error code 3734 in access vba

[atksamy]

i have the following code and in the line no 19 i am getting runtime error 3734
" the database is locked by user name......canno t be opened or saved"

Sub plausibilitaet_check()

Dim rs As DAO.Recordset
Dim rs2 As ADODB.Recordset
Dim db As database
Dim strsql As String
Dim tdf As TableDef




Set db = opendatabase("C:\Codebook.mdb")
Set rs = db.OpenRecordset("plausibilitaeten")

Set rs2 = CreateObject("ADODB.Recordset")
rs2.ActiveConnection = CurrentProject.Connection


For Each tdf In CurrentDb.TableDefs
   
   
   
   
   If Left(tdf.Name, 4) <> "MSys" Then
        rs.MoveFirst
        strsql = "SELECT * From [" & tdf.Name & "] WHERE "

        Do While Not rs.EOF
            On Error Resume Next
            Debug.Print tdf.Name
            rs2.Open strsql & " " & rs![plausibilitaet_alt]
            If Err.Number = 0 Then
                On Error GoTo 0
                If Not rs2.EOF Then
                    Debug.Print rs![Error]
                    Debug.Print rs2.GetString
                End If
            End If
            Err.Clear
            rs2.Close
            rs.MoveNext

        Loop
    End If
Next
End Sub

can someone tell me what am i doing wrong

[NeoPa]

This indicates that someone, somewhere, has the database open exclusively. This can be done manually, or it will happen automatically when anyone makes design changes to any of the objects.

Is "user name ....." referring to you or another user?

If the worst comes to the worst and you can't get it to clear down even when everyone has stopped using it then find and delete the .LDB file associated with the .MDB. Be careful not to do this when anyone is using the .MDB if at all possible.

[atksamy]

hmmm funny i am the only one using this and today suddenly the error is not coming

[NeoPa]

In that case it was probably as simple as your just having made some design changes in the current session (which would have locked out the database for various items).

[atksamy]

THe code provided works fine when i run it as it is

but when i add the following lines of code

Dim objexcel As Excel.Application
                     Dim wbexcel As Excel.Workbook
                     Dim wbExists As Boolean
                     Dim objSht As Excel.Worksheet
                     Dim objRange As Excel.Range
                     
                     
                     Set objexcel = CreateObject("excel.Application")
                     objexcel.Visible = True
                     On Error GoTo Openwb
                     wbExists = False
                     Set wbexcel = objexcel.Workbooks.Open("C:\Documents and Settings\TAYYAPP\Desktop\test folder\reports\ERROR REPORT3.xls")
                     Set objSht = wbexcel.Worksheets("Sheet1")
                     objSht.Activate
                     wbExists = True
Openwb:
                     
                     On Error GoTo 0
                     If Not wbExists Then
                     objexcel.Workbooks.Add
                     Set wbexcel = objexcel.ActiveWorkbook
                     Set objSht = wbexcel.Worksheets("Sheet1")

                     End If

in the beginning i get some parameter expected runtime error in line no 31 of the code given in post 1.

what i dont understand is there is no connection between the two sets of codes

th e exact runtime error is 2147217904(8004 0e10)

[NeoPa]

I'm struggling to understand what you've added where and whereabouts the error comes up in all of this.

Adding a chunk of code is not like simple arithmetic. It must be added at a certain point, or in some way that needs explaining.

[atksamy]

Here is the code

Option Explicit

Sub plausibilitaet_check()

Dim rs As DAO.Recordset
Dim rs2 As ADODB.Recordset
Dim db As database
Dim strsql As String
Dim tdf As TableDef
Dim i, j As Integer
i = 1


'OPEN excel DOCUMENT FOR WRITING REPORT
  
                     Dim objexcel As Excel.Application
                     Dim wbexcel As Excel.Workbook
                     Dim wbExists As Boolean
                     Dim objSht As Excel.Worksheet
                     Dim objRange As Excel.Range
                     
                     
                     Set objexcel = CreateObject("excel.Application")
                     objexcel.Visible = True
                     On Error GoTo Openwb
                     wbExists = False
                     Set wbexcel = objexcel.Workbooks.Open("C:\Documents and Settings\TAYYAPP\Desktop\test folder\reports\ERROR REPORT3.xls")
                     Set objSht = wbexcel.Worksheets("Sheet1")
                     objSht.Activate
                     wbExists = True
Openwb:
                     
                     On Error GoTo 0
                     If Not wbExists Then
                     objexcel.Workbooks.Add
                     Set wbexcel = objexcel.ActiveWorkbook
                     Set objSht = wbexcel.Worksheets("Sheet1")

                     End If


Set db = opendatabase("C:\Documents and Settings\TAYYAPP\Desktop\GIDAS_Codebook.mdb")
Set rs = db.OpenRecordset("plausibilitaeten")

Set rs2 = CreateObject("ADODB.Recordset")
rs2.ActiveConnection = CurrentProject.Connection


For Each tdf In CurrentDb.TableDefs
   
   If Left(tdf.Name, 4) <> "MSys" Then
        rs.MoveFirst
        strsql = "SELECT * From [" & tdf.Name & "] WHERE "

        Do While Not rs.EOF
            On Error Resume Next
            
            rs2.Open strsql & " " & rs![plausibilitaet_alt]
            If Err.Number = 0 Then
                On Error GoTo 0
                If Not rs2.EOF Then
                    
                            If tdf.Name <> "01umwelt" Then
                            
                            
                            i = i + 1
                            j = 1
                           
                            objSht.Cells(i, j).Value = "Tabelle:  " & tdf.Name
                            j = j + 1
                            objSht.Cells(i, j).Value = "kombinationsschluessel: FALL " & rs2.Fields(0)
                            j = j + 1
                            objSht.Cells(i, j).Value = "Error:  " & rs![fehlermeldung]
                            
                            
                            
                            End If
                            'Debug.Print tdf.Name
                            'Debug.Print rs![fehlermeldung]
                            'Debug.Print rs2.Fields(0)
                End If
            End If
            Err.Clear
            rs2.Close
            rs.MoveNext

        Loop
    End If
Next
End Sub

in line no 58 i get a runtime error 2147217904(8004 0e10) parameter missing

but if i run the code as given in post#1 it is fine
only when i add the code for opening excel i get this error

[atksamy]

THanks for having a look but i guess the on error statements were causing the problem.

i moved the excel part to another sub and now the code runs fine

thanks
anyway.

[NeoPa]

I always feel the On Error ... commands in VBA are a bit of a bodge. They don't nest properly and are procedure relative.

When using such code it is often necessary to separate out functionality into logical procedures as you have done. It's nearly always the better design anyway mind you, having separate concepts in their own procedures, so it may be a bonus in disguise.