Huge problem...
I've created an application which creates a database from scratch and opens several other applications. On my main form there are several buttons, one to create the database and two buttons to open two other applications. These buttons all work fine. The applications open as desired BUT...
When I press the button "Create Tables" and then "Open Report" I get the following error message "The database has been placed in a state by user 'Admin' that prevents it from being opened or locked." from the application which opens the report. This message does not occur when opening the report without pressing the button "Create Tables" first, so the problem must be somewhere in the code that creates the tables. I guess my database is locked in some way and it shouldn't.
I've looked at the .ldb file in both cases but it always contains the same line.
Here's the code to create the tables:
*********************************************
Option Compare Database
Function Create_tables()
Dim db As Database
Dim rs1 As Recordset
Dim rs2 As Recordset
Dim tableSQL As String
Dim tdf As TableDef
Dim arr As Variant
Dim i As Integer
Dim qdf As QueryDef
Set db = CurrentDb
For Each tdf In db.TableDefs
If tdf.Name = "MSWSTAT" Then
DoCmd.DeleteObject acTable, "MSWSTAT"
End If
Next
DoCmd.TransferDatabase acImport, "dBase III", "C:\New Weave", acTable, "MSWSTAT.dbf", "MSWSTAT"
tableSQL = "Alter TABLE [MSWSTAT] ADD COLUMN Type Varchar(20);"
db.Execute (tableSQL)
tableSQL = "Alter TABLE [MSWSTAT] ADD COLUMN Huidig Date;"
db.Execute (tableSQL)
tableSQL = "Alter TABLE [MSWSTAT] ADD COLUMN ParamID Integer;"
db.Execute (tableSQL)
tableSQL = "Create INDEX P_Id ON MSWSTAT (ParamID);"
db.Execute (tableSQL)
Set rs1 = db.OpenRecordset("MSWSTAT")
rs1.MoveFirst
Do While Not rs1.EOF
rs1.Edit
If IsNull(rs1!kwaliteit) And rs1!lengtecm = 0 And IsNull(rs1!afmeting) And IsNull(rs1!dessin) And IsNull(rs1!kleur) And Not IsNull(rs1!omschrijv) Then
rs1!Type = "Diversen"
ElseIf Not IsNull(rs1!kwaliteit) And rs1!lengtecm = 0 And IsNull(rs1!afmeting) And Not IsNull(rs1!dessin) And Not IsNull(rs1!kleur) And IsNull(rs1!omschrijv) Then
rs1!Type = "Meubelstoffen"
ElseIf Not IsNull(rs1!kwaliteit) And rs1!lengtecm <> 0 And Not IsNull(rs1!afmeting) And Not IsNull(rs1!dessin) And Not IsNull(rs1!kleur) And IsNull(rs1!omschrijv) Then
rs1!Type = "Tapijten"
End If
rs1!Huidig = Date
rs1!ParamID = 1
rs1.Update
rs1.MoveNext
Loop
For Each tdf In db.TableDefs
If tdf.Name = "param_select" Then
DoCmd.DeleteObject acTable, "param_select"
End If
Next
tableSQL = "Create table param_select (param varchar(15));"
db.Execute (tableSQL)
Set rs2 = db.OpenRecordset("param_select")
arr = Array("Country", "Customer", "Quality", "Pattern", "Colour")
i = 0
Do While i < 5
rs2.AddNew
rs2!param = arr(i)
rs2.Update
i = i + 1
Loop
For Each tdf In db.TableDefs
If tdf.Name = "params" Then
DoCmd.DeleteObject acTable, "params"
End If
Next
tableSQL = "Create table params (ID integer, Param1 varchar(15)," & _
"Param2 varchar(15), Param3 varchar(15), Param4 varchar(15)," & _
"Param5 varchar(15), PRIMARY KEY (ID));"
db.Execute (tableSQL)
For Each qdf In db.QueryDefs
If qdf.Name = "Type" Then
DoCmd.DeleteObject acQuery, "Type"
End If
Next
db.CreateQueryDef "Type", "Select distinct type from [MSWSTAT]where type <> 'Diversen'"
End Function
********************************************
Could anyone tell me where I went wrong?
Thanx in advance.
I've created an application which creates a database from scratch and opens several other applications. On my main form there are several buttons, one to create the database and two buttons to open two other applications. These buttons all work fine. The applications open as desired BUT...
When I press the button "Create Tables" and then "Open Report" I get the following error message "The database has been placed in a state by user 'Admin' that prevents it from being opened or locked." from the application which opens the report. This message does not occur when opening the report without pressing the button "Create Tables" first, so the problem must be somewhere in the code that creates the tables. I guess my database is locked in some way and it shouldn't.
I've looked at the .ldb file in both cases but it always contains the same line.
Here's the code to create the tables:
*********************************************
Option Compare Database
Function Create_tables()
Dim db As Database
Dim rs1 As Recordset
Dim rs2 As Recordset
Dim tableSQL As String
Dim tdf As TableDef
Dim arr As Variant
Dim i As Integer
Dim qdf As QueryDef
Set db = CurrentDb
For Each tdf In db.TableDefs
If tdf.Name = "MSWSTAT" Then
DoCmd.DeleteObject acTable, "MSWSTAT"
End If
Next
DoCmd.TransferDatabase acImport, "dBase III", "C:\New Weave", acTable, "MSWSTAT.dbf", "MSWSTAT"
tableSQL = "Alter TABLE [MSWSTAT] ADD COLUMN Type Varchar(20);"
db.Execute (tableSQL)
tableSQL = "Alter TABLE [MSWSTAT] ADD COLUMN Huidig Date;"
db.Execute (tableSQL)
tableSQL = "Alter TABLE [MSWSTAT] ADD COLUMN ParamID Integer;"
db.Execute (tableSQL)
tableSQL = "Create INDEX P_Id ON MSWSTAT (ParamID);"
db.Execute (tableSQL)
Set rs1 = db.OpenRecordset("MSWSTAT")
rs1.MoveFirst
Do While Not rs1.EOF
rs1.Edit
If IsNull(rs1!kwaliteit) And rs1!lengtecm = 0 And IsNull(rs1!afmeting) And IsNull(rs1!dessin) And IsNull(rs1!kleur) And Not IsNull(rs1!omschrijv) Then
rs1!Type = "Diversen"
ElseIf Not IsNull(rs1!kwaliteit) And rs1!lengtecm = 0 And IsNull(rs1!afmeting) And Not IsNull(rs1!dessin) And Not IsNull(rs1!kleur) And IsNull(rs1!omschrijv) Then
rs1!Type = "Meubelstoffen"
ElseIf Not IsNull(rs1!kwaliteit) And rs1!lengtecm <> 0 And Not IsNull(rs1!afmeting) And Not IsNull(rs1!dessin) And Not IsNull(rs1!kleur) And IsNull(rs1!omschrijv) Then
rs1!Type = "Tapijten"
End If
rs1!Huidig = Date
rs1!ParamID = 1
rs1.Update
rs1.MoveNext
Loop
For Each tdf In db.TableDefs
If tdf.Name = "param_select" Then
DoCmd.DeleteObject acTable, "param_select"
End If
Next
tableSQL = "Create table param_select (param varchar(15));"
db.Execute (tableSQL)
Set rs2 = db.OpenRecordset("param_select")
arr = Array("Country", "Customer", "Quality", "Pattern", "Colour")
i = 0
Do While i < 5
rs2.AddNew
rs2!param = arr(i)
rs2.Update
i = i + 1
Loop
For Each tdf In db.TableDefs
If tdf.Name = "params" Then
DoCmd.DeleteObject acTable, "params"
End If
Next
tableSQL = "Create table params (ID integer, Param1 varchar(15)," & _
"Param2 varchar(15), Param3 varchar(15), Param4 varchar(15)," & _
"Param5 varchar(15), PRIMARY KEY (ID));"
db.Execute (tableSQL)
For Each qdf In db.QueryDefs
If qdf.Name = "Type" Then
DoCmd.DeleteObject acQuery, "Type"
End If
Next
db.CreateQueryDef "Type", "Select distinct type from [MSWSTAT]where type <> 'Diversen'"
End Function
********************************************
Could anyone tell me where I went wrong?
Thanx in advance.