Can anybody help with this
I have a SQL database with Tables I want to make a copy of in an access database on a remote PC
Now the creation of the database, tables, primary keys is fine. The problem is a part of the code creates an autonumber field on some tables and then leaves a lock on the database. If I remove the code it leaves no lock after it has completed.
Here is the code
The problem is this bit of codeCode:Public Function blnCreateTable(ByVal strTableName As String, ByVal strDBLocation As String, ByVal bytDB As Byte) As Boolean Dim intLoopX As Integer Dim intLoopY As Integer Dim rsSchema As ADODB.Recordset Dim tblCT As ADOX.Table Dim catCT As ADOX.Catalog Dim tType As ADODB.DataTypeEnum Dim pkCT As ADOX.Key 'Initialise variable blnCreateTable = False 'Retrieve the table columns schema Select Case bytDB Case 0 'CT Database Set rsSchema = gconMain.OpenSchema(adSchemaColumns, Array(Empty, Empty, strTableName)) Case 1 'Security database Set rsSchema = gconSecurity.OpenSchema(adSchemaColumns, Array(Empty, Empty, strTableName)) End Select 'Open connection to the Access database Set catCT = New ADOX.Catalog Set tblCT = New ADOX.Table catCT.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;" & _ "Data Source=" & strDBLocation & ";" With rsSchema Do Until .EOF 'Create table name tblCT.Name = strTableName 'For intLoopX = 0 To .Fields.Count - 1 'Change the data type to and Access friendly type 'and append the field to the collection Select Case .Fields("DATA_TYPE").Value Case 3 'long in SQL Server tType = adInteger Case 2 'int in SQL Server tType = adInteger Case 5 'Float in SQL Server tType = adDouble Case 17 'tinyint in SQl Server tType = adUnsignedTinyInt Case 128 tType = adLongVarBinary Case 200, 129 'varchar in SQL Server tType = adVarWChar Case 11 'bit in SQL Server tType = adBoolean Case 6 'money in SQL Server tType = adCurrency Case 135 'date/time in SQL Server tType = adDate End Select 'Will return null if filed is standered length 'i.e. int, long If IsNull(.Fields("CHARACTER_MAXIMUM_LENGTH").Value) Then tblCT.Columns.Append .Fields("COLUMN_NAME").Value, tType Else tblCT.Columns.Append .Fields("COLUMN_NAME").Value, tType, _ .Fields("CHARACTER_MAXIMUM_LENGTH").Value End If If .Fields("IS_NULLABLE").Value = True Then tblCT.Columns(.Fields("COLUMN_NAME").Value).Attributes = adColNullable End If If strTableName = "tblTillTransactionHeader" And .Fields("COLUMN_NAME").Value = "TTrnHdrTranNo" Then tblCT.Columns(.Fields("COLUMN_NAME").Value).ParentCatalog = catCT tblCT.Columns(.Fields("COLUMN_NAME").Value).Properties("AutoIncrement") = True End If If strTableName = "tblTillDailyHeader" And .Fields("COLUMN_NAME").Value = "TDlyHdrNo" Then tblCT.Columns(.Fields("COLUMN_NAME").Value).ParentCatalog = catCT tblCT.Columns(.Fields("COLUMN_NAME").Value).Properties("AutoIncrement") = True End If rsSchema.MoveNext Loop End With 'Append the table to 'the database catCT.Tables.Append tblCT 'Open a primary key schema so we can use this to 'append the primary keys to the Access table Select Case bytDB Case 0 'CT Database Set rsSchema = gconMain.OpenSchema(adSchemaPrimaryKeys, Array(Empty, Empty, strTableName)) Case 1 'Security Database Set rsSchema = gconSecurity.OpenSchema(adSchemaPrimaryKeys, Array(Empty, Empty, strTableName)) End Select Set pkCT = New ADOX.Key 'Create the Primary Key pkCT.Name = "PrimaryKey" pkCT.Type = adKeyPrimary Do Until rsSchema.EOF 'Append table columns to the primary key pkCT.Columns.Append rsSchema.Fields("COLUMN_NAME").Value rsSchema.MoveNext Loop Set tblCT = catCT.Tables(strTableName) 'Append the Key object to the Keys collection of Table tblCT.Keys.Append pkCT Set pkCT = Nothing Set tblCT = Nothing rsSchema.Close Set rsSchema = Nothing Set catCT = Nothing blnCreateTable = True
If I take this bit of code out it is fine but when this piece of code is left in it leaves a lock on the databaseCode:If strTableName = "tblTillTransactionHeader" And .Fields("COLUMN_NAME").Value = "TTrnHdrTranNo" Then tblCT.Columns(.Fields("COLUMN_NAME").Value).ParentCatalog = catCT tblCT.Columns(.Fields("COLUMN_NAME").Value).Properties("AutoIncrement") = True End If If strTableName = "tblTillDailyHeader" And .Fields("COLUMN_NAME").Value = "TDlyHdrNo" Then tblCT.Columns(.Fields("COLUMN_NAME").Value).ParentCatalog = catCT tblCT.Columns(.Fields("COLUMN_NAME").Value).Properties("AutoIncrement") = True End If
Thanks


Gary Lowe 

Reply With Quote