Error 3211 - tbl already in use

[darren via AccessMonster.com]

Hi, I'm trying to run the following code in a FE to make changes to the BE.
However, I get error 3211 - tblPolicyTransfer already in use when it get to:

With tbl
..fields.Delete "TfrBidOffer"

Any ideas or suggestions?

----------------------------------------
Full Code below:

Public Function fnUpgrade20()
On Error GoTo Err_fnUpgrade20

' This upgrade is to:
' 1) add OtherAnnualIncome field to tblEmployees
' 2) move fields TfrBidOffer & TfrAMC up from tblPolicyTransfer to
tblPolicies
' 3) prepop date fields replacing tick boxes in tblPolicyTransfer

chk = False
Debug.Print "fnUpgrade20"

Dim db As Database
Dim tbl As TableDef
Dim fld As Field
Dim prp As Property
Dim ind As Index
Dim sql As String

BeginTrans

Set db = OpenDatabase(p_strBEpath, False, False, p_strBEpass)

' 1) add OtherAnnualIncome field to tblEmployees
Set tbl = db.TableDefs("tblEmployees")

With tbl
.Fields.Append .CreateField("EeOtherAnnInc", dbCurrency)
End With

Set fld = tbl.Fields("EeOtherAnnInc")

With fld
.DefaultValue = 0
.Required = True
End With

Set prp = fld.CreateProperty("Caption", dbText, "Other Annual Income")
fld.Properties.Append prp

Set prp = fld.CreateProperty("Description", dbText, "Other Annual Income")

fld.Properties.Append prp

' 2) move fields TfrBidOffer & TfrAMC up from tblPolicyTransfer to
tblPolicies
Set tbl = db.TableDefs("tblPolicies")

With tbl
.Fields.Append .CreateField("PolAMC", dbCurrency)
.Fields.Append .CreateField("PolBidOffer", dbCurrency)
End With

Set fld = tbl.Fields("PolAMC")

With fld
.DefaultValue = 0
.Required = True
.ValidationRule = "Between 0 And 1"
.ValidationText = "The value must be less than 100% (1.00)."
End With

Set prp = fld.CreateProperty("Caption", dbText, "Policy AMC")
fld.Properties.Append prp

Set prp = fld.CreateProperty("Description", dbText, "Policy AMC %")
fld.Properties.Append prp

Set prp = fld.CreateProperty("Format", dbText, "Percent")
fld.Properties.Append prp

Set fld = tbl.Fields("PolBidOffer")

With fld
.DefaultValue = 0
.Required = True
.ValidationRule = "Between 0 And 1"
.ValidationText = "The value must be less than 100% (1.00)."
End With

Set prp = fld.CreateProperty("Caption", dbText, "Bid Offer Spread")
fld.Properties.Append prp

Set prp = fld.CreateProperty("Description", dbText, "Bid Offer Spread %")
fld.Properties.Append prp

Set prp = fld.CreateProperty("Format", dbText, "Percent")
fld.Properties.Append prp

' make sure EeOtherAnnInc is not null
sql = "UPDATE tblEmployees SET tblEmployees.EeOtherAnnInc = 0 WHERE ((
(tblEmployees.EeOtherAnnInc) Is Null));"
db.Execute sql, dbFailOnError

' where there is transfer data updates the new policy fields
sql = "UPDATE tblPolicies INNER JOIN tblPolicyTransfer ON tblPolicies.
PolicyID = tblPolicyTransfer.PolicyID SET tblPolicies.PolAMC =
[tblPolicyTransfer].[TfrAMC] " & _
"WHERE (((tblPolicies.PolAMC) Is Null Or (tblPolicies.PolAMC)=0) And (
(tblPolicyTransfer.TfrAMC) Is Not Null));"
'Debug.Print sql
db.Execute sql, dbFailOnError

sql = "UPDATE tblPolicies INNER JOIN tblPolicyTransfer ON tblPolicies.
PolicyID = tblPolicyTransfer.PolicyID SET tblPolicies.PolBidOffer =
[tblPolicyTransfer].[TfrBidOffer] " & _
"WHERE (((tblPolicies.PolBidOffer) Is Null Or (tblPolicies.PolBidOffer)=0)
AND ((tblPolicyTransfer.TfrBidOffer) Is Not Null));"
'Debug.Print sql
db.Execute sql, dbFailOnError

' where policy is with existing employer use scheme defaults
sql = "UPDATE tblSchemes INNER JOIN tblPolicies ON tblSchemes.SchemeID =
tblPolicies.SchemeID SET tblPolicies.PolAMC = [tblSchemes].[SchAMC] " & _
"WHERE (((tblPolicies.PolAMC) Is Null Or (tblPolicies.PolAMC)=0) AND (
(tblPolicies.PolScheme)=1 Or (tblPolicies.PolScheme)=2) AND ((tblSchemes.
SchAMC) Is Not Null));"
'Debug.Print sql
db.Execute sql, dbFailOnError

sql = "UPDATE tblSchemes INNER JOIN tblPolicies ON tblSchemes.SchemeID =
tblPolicies.SchemeID SET tblPolicies.PolBidOffer = 1-[tblSchemes].
[SchAllocRate] " & _
"WHERE (((tblPolicies.PolBidOffer) Is Null Or (tblPolicies.PolBidOffer)=0)
AND ((tblPolicies.PolScheme)=1 Or (tblPolicies.PolScheme)=2) AND ((tblSchemes.
SchAllocRate) Is Not Null));"
'Debug.Print sql
db.Execute sql, dbFailOnError

' finally make sure there are no nulls left
sql = "UPDATE tblPolicies SET tblPolicies.PolAMC = 0 WHERE (((tblPolicies.
PolAMC) Is Null));"
db.Execute sql, dbFailOnError

sql = "UPDATE tblPolicies SET tblPolicies.PolBidOffer = 0 WHERE ((
(tblPolicies.PolBidOffer) Is Null));"
db.Execute sql, dbFailOnError

' 3) prepop date fields replacing tick boxes in tblPolicyTransfer
sql = "UPDATE tblPolicyTransfer SET [TfrLOADate] = #12/31/1980# WHERE ((
[TfrLOASent]=True));"
db.Execute sql, dbFailOnError

sql = "UPDATE tblPolicyTransfer SET [TfrInfoDate] = #12/31/1980# WHERE ((
[TfrDetailBack]=True));"
db.Execute sql, dbFailOnError

sql = "UPDATE tblPolicyTransfer SET [TfrFeeRecDate] = #12/31/1980# WHERE ((
[TfrFeeReceived]=True));"
db.Execute sql, dbFailOnError

sql = "UPDATE tblPolicyTransfer SET [TfrCompletionDate] = #12/31/1980# WHERE
(([TfrCompleted]=True));"
db.Execute sql, dbFailOnError

' Delete fields from tblPolicyTransfer
Set tbl = db.TableDefs("tblPolicyTransfer")

With tbl
.Fields.Delete "TfrBidOffer"
.Fields.Delete "TfrAMC"
End With

CommitTrans
chk = True

Exit_fnUpgrade20:
Set db = Nothing
Set tbl = Nothing
Set fld = Nothing
Set prp = Nothing
Set ind = Nothing
Exit Function

Err_fnUpgrade20:
Rollback
chk = False
MsgBox "fnUpgrade20: " & Err.Number & " - " & Err.Description
Resume Exit_fnUpgrade20

End Function

 

[darrensawyer via AccessMonster.com]

Just thought I'd add that I have checked no one else is in the database.