FIX: Cannot Use ADOX to Set Default Value for Column Property

Steps to Reproduce Behavior

1. Create a new Standard EXE in Visual Basic. Form1 is created by default.
2. Add a Project Reference to Microsoft ActiveX Data Object 2.6 and Microsoft ADO Ext 2.6 for DDL and Security.
3. Copy the following code into the code section of Form1:

   Option Explicit
   
   Private Sub Form_Load()
       Dim WorkString As String
       Dim SQL As String
       Dim DatabasePath As String
       Dim DBCatalog As ADOX.Catalog
       Dim DBTable As ADOX.Table
       Dim DBColumn As ADOX.Column
   On Error GoTo ErrHandler
   
       DatabasePath = App.Path & "\TestDB.mdb" 
       On Error Resume Next 'Ignore error deleting old database.
       Kill DatabasePath
       On Error GoTo ErrHandler
       Set DBCatalog = New ADOX.Catalog
       WorkString = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & DatabasePath & ";"
       
       DBCatalog.Create WorkString 
       Set DBTable = New ADOX.Table
       DBTable.Name = "TestTable"
       Set DBTable.ParentCatalog = DBCatalog
       Set DBColumn = New ADOX.Column
       
       With DBColumn
           .Name = "TestColumn"
           .Type = adInteger
           .DefinedSize = 0
           .Attributes = adColFixed
           .NumericScale = 0
           .Precision = 10
       End With
       
       DBTable.Columns.Append DBColumn
       DBCatalog.Tables.Append DBTable
       Set DBTable = DBCatalog.Tables("TestTable")
       
       DBTable.Columns("TestColumn").Properties("Default").Value = 5
       If DBTable.Columns("TestColumn").Properties("Default").Value <> 5 Then 
           debug.print "Default property not set properly."
           SQL = "Alter Table TestTable "
           SQL = SQL & "Alter Column TestColumn "
           SQL = SQL & "Set Default 5 "
           DBCatalog.ActiveConnection.Execute SQL 'Set the default property
       End If
       Exit Sub
   ErrHandler:
       Debug.Assert False 'Stop on any error.
       MsgBox "Error: " & Err.Number & " " & Err.Description
       Resume
   End Sub
   					

4. Run the code. You receive the above-mentioned error message in the Immediate window.

Back to the top