TableDef.Fields not in sync with table

[TinkerMan]

Hi

I have a strange problem, where I might do something stupid, but none the less, it's a puzzler (to me at least).

I do an ALTER TABLE to add a new column. After that I have a routine that get's the TableDef for that table, and loops (as It fails if I ask for it directly) until i finds the column and sets the default value.

When I run this first time, I add the column, but the second routine fails to locate the column for adding the default value. Second time the check which tries to detect if the column already exists also uses the TableDef-loop approach, which cannot find the column, and therefore I'm getting the error I tried avoiding, namely "Column already exists" as the ALTER TABLE i executed again.

If I Compact and Repair, everything is in sync, and first routine avoids creating the new column, and the second routine finds the column and set the default value.

As it is very consistant, if I delete the column, and run again; same problem, but reverse: It is detected as being there, so the ALTER TABLE does not run, but I get an error when I'm trying to set the DefaultValue for the column that does not exist

Is there a way to commit changes so I know that the TableDef is in sync with the table?

Here is the ALTER TABLE function:

Function addColumn2Table(tableName As String, colName As String, colType As String)
  If (Not doesColumnExist(tableName, colName)) Then
    Dim db As Database
    Dim alterSql As String
    Set db = CurrentDb
    alterSql = "Alter table " & tableName & " add column " & colName & " " & colType
    'MsgBox alterSql
    db.Execute alterSql
    db.Close
  End If
End Function

Second function that sets DefaultValue

Function setColumnDefaultValue(tableName As String, colName As String, colValue As String)
  If (Not doesTableExist(tableName)) Then
    Err.Raise vbObjectError + 1024, setColumnDefaultValue, "Table """ & tableName & """ does not exist."
  End If
  Dim db As Database
  Dim td As DAO.TableDef
  Dim fld As DAO.Field
  Set db = DBEngine(0)(0)
  Set td = db.TableDefs(tableName)
  
  Dim realColName As String
  realColName = colName
  If (Left(colName, 1) = "[") Then
    realColName = Left(Right(colName, Len(colName) - 1), Len(colName) - 2)
  End If

  For Each fld In td.Fields
    If (fld.Name = realColName) Then
      fld.DefaultValue = colValue
    End If
  Next
  Set fld = Nothing
  Set td = Nothing
  db.Close
End Function

Here is the function that checks if a column already exists:

Function doesColumnExist(tableName As String, colName As String) As Boolean
  doesColumnExist = False
  If (Not doesTableExist(tableName)) Then
    Err.Raise vbObjectError + 1024, doesColumnExist, "Table """ & tableName & """ does not exist."
  End If
  Dim db As Database
  Dim td As DAO.TableDef
  Dim fld As DAO.Field
  Set db = DBEngine(0)(0)
  Set td = db.TableDefs(tableName)
  
  Dim realColName As String
  realColName = colName
  If (Left(colName, 1) = "[") Then
    realColName = Left(Right(colName, Len(colName) - 1), Len(colName) - 2)
  End If
  For Each fld In td.Fields
    If (fld.Name = realColName) Then
      doesColumnExist = True
    End If
  Next
  'MsgBox colName & "(" & tableName & "): " & doesColumnExist
  Set fld = Nothing
  Set td = Nothing
  db.Close

End Function

I have executed this in trace mode, so I have verified that the column is missing/there as described above.

Thanks again

 

[raskew]

Hi -

Here's a little different approach that will hopefully provide the
required end result. Copy/paste the following code to a new
module then call it as shown in the comments, specifying a
test table, and a field name of your choice.

HTH - Bob

Public Sub AddMeAField(ptbl As String, _
           pfld As String, _
           ptype As Variant, _
           Optional pSize As Integer, _
           Optional pValue As Variant)

'*******************************************
'purpose:  programatically add a field to a
'          table and optionally set a default
'          value for the field.
'coded by: raskew
'calls:    AppendDeleteField()
'inputs:   from the debug (immediate window):
'          Call AddMeAField("tblMyTable", "fldNew", dbinteger,,5)
'*******************************************
           
Dim db  As Database
Dim tdf As TableDef
Dim fld As Field
Dim NL  As String

Set db = CurrentDb
Set tdf = db.TableDefs(ptbl)
    NL = Chr(13) & Chr(10) 'new line
    'populate pValue
    pValue = IIf(IsMissing(pValue), "", pValue)
    'check to see if field already exists
    For Each fld In tdf.Fields
       If fld.name = pfld Then
          MsgBox "Field name " & pfld & " already exists! " & NL & _
                "Unable to complete task.", vbOKOnly, "Oops!!"
          Exit Sub
         'quit the loop if successful
         Exit For
       End If
    Next fld

    AppendDeleteField tdf, "APPEND", pfld, ptype
    If Not (IsNull(pValue) Or pValue = "") Then
       tdf.Fields(pfld).DefaultValue = pValue
    End If
    Set tdf = Nothing
    db.Close
    Set db = Nothing
    docmd.OpenTable ptbl, acViewDesign
End Sub
'**************************************
Sub AppendDeleteField(tdfTemp As TableDef, _
    strCommand As String, _
    strName As String, _
    Optional varType, _
    Optional varSize)
' This procedure adds or deletes fields from
' a Table Def, as specified.  Think it may
' have come from the MSKB, but am not sure.
'
' ARGUMENTS:
' tdfTemp: A table def.
' strCommand: "APPEND" or "DELETE"
' strName: Name of field, as a string.
' varType: Optional--type of field
' varSize: Optional--field size as integer

    With tdfTemp
    
    ' Check first to see if the TableDef object is
    ' updatable. If it isn't, control is passed back to
    ' the calling procedure.
            
    If .Updatable = False Then
        MsgBox "TableDef not Updatable! " & _
            "Unable to complete task."
        Exit Sub
    End If
    
    ' Depending on the passed data, append or delete a
    ' field to the Fields collection of the specified
    ' TableDef object.
    If strCommand = "APPEND" Then
        .Fields.Append .CreateField(strName, _
            varType, varSize)
    Else
        If strCommand = "DELETE" Then .Fields.Delete strName
    End If
    
    End With
    
End Sub