Access 2013
Code that has been working is suddenly causing the error "Object invalid or no longer set". Line causing the error is marked.
Anyone run into this before? I've spent half the day on this getting nowhere fast.
Code that has been working is suddenly causing the error "Object invalid or no longer set". Line causing the error is marked.
Anyone run into this before? I've spent half the day on this getting nowhere fast.
Code:
Private Sub CreateTable()
Dim dbsDb As dao.Database
Dim tblTemp As dao.TableDef
Dim fldTemp As dao.Field
Dim rst As dao.Recordset
Dim rstRsF As dao.Recordset
Set dbsDb = CurrentDb
'Select distinct values of strCltCdK to be used as table names
Set rst = dbsDb.OpenRecordset("SELECT DISTINCT qselNewCltTbl.strCltCdK FROM qselNewCltTbl ORDER BY qselNewCltTbl.strCltCdK;")
'loop to each distinct value of strCltCdK
While Not rst.EOF
'if the table to be created exists, delete it
If fncExists("ttbl" & rst!strCltCdK) Then
DeleteTable ("ttbl" & rst!strCltCdK)
End If
'code to initialize creation of table
Set tblTemp = dbsDb.CreateTableDef("ttbl" & rst!strCltCdK)
'create recordset to select all records equal to the current table name(strCltCdK) and use the value in the field strFldNmK as the field name
Set rstRsF = dbsDb.OpenRecordset("SELECT qselNewCltTbl.intSq, qselNewCltTbl.strFldNmK, qselNewCltTbl.txtDscr, qselNewCltTbl.strTpK FROM qselNewCltTbl WHERE (((qselNewCltTbl.strCltCdK) = '" & rst!strCltCdK & "')) ORDER BY qselNewCltTbl.strCltCdK, qselNewCltTbl.intSq ")
While Not rstRsF.EOF
'since data type stated in field strTpK is not correct syntax, we'll use select case to change to appropriate data type used by Access
Select Case rstRsF!strTpK
Case "auto number"
Set fldTemp = tblTemp.CreateField(rstRsF!strFldNmK, dbLong)
Case "Currency"
Set fldTemp = tblTemp.CreateField(rstRsF!strFldNmK, dbDouble)
Case "Date/Time"
Set fldTemp = tblTemp.CreateField(rstRsF!strFldNmK, dbDate)
Case "Double"
Set fldTemp = tblTemp.CreateField(rstRsF!strFldNmK, dbDouble)
'code to create field
>> tblTemp.Fields.Append fldTemp
Set fldTemp = Nothing
rstRsF.MoveNext
Wend
rstRsF.Close
'add table
dbsDb.TableDefs.Append tblTemp
rst.MoveNext
Set tblTemp = Nothing
Wend
rst.Close
dbsDb.Close
End Sub