Home > database >  MS access VBA Field.Properties.Append method fails
MS access VBA Field.Properties.Append method fails

Time:02-02

I have a form that creates a table. Everything works fine except for one point.

I want one field of the created table to appear as a combobox, so I have to change its DisplayControl property to acComboBox.

As far as I know, the property firstly has to exist. If not, then you have to create it and then append it to the collection.

The problem is that when it comes to append the property it throws a Run-time error '3219': Invalid operation..

Here is the code to this point:

Private Sub bInsert_Click()
Dim accApp As Access.Application
Dim DB As DAO.Database
Dim tbl As DAO.TableDef
Dim fld As DAO.Field
Dim indx As DAO.Index
Dim rst As DAO.Recordset
Dim i As Integer, iFields As Integer
Dim sForm As String, str As String
Dim frm As Access.Form
Dim sCtrl() As String
    If Not Application.IsCompiled Then _
        Application.RunCommand acCmdCompileAndSaveAllModules
'there is a subform for the fields:
    Set rst = Me.subfFields.Form.Recordset
    rst.MoveFirst
'completion check:
    If IsNull(Me.tName) Then
        MsgBox "Insert table name."
        Exit Sub
    ElseIf rst.AbsolutePosition = -1 Then
        MsgBox "Insert at least one field."
        Exit Sub
    End If
'create a db that will use later:
    If Dir(Me.tDB) = "" Then
        Set accApp = New Access.Application
        accApp.NewCurrentDatabase Me.tDB
        accApp.Quit
        Set accApp = Nothing
    End If
'create Table:
    Set DB = Application.CurrentDb
    Set tbl = DB.CreateTableDef(Me.tName)
'ID as PK:
    Set fld = tbl.CreateField("ID", dbLong)
    fld.Attributes = dbAutoIncrField
    tbl.Fields.Append fld
    Set indx = tbl.CreateIndex("IDindex")
    indx.Primary = True
    Set fld = indx.CreateField("ID")
    indx.Fields.Append fld
    tbl.Indexes.Append indx
    Set indx = Nothing
    Set fld = Nothing
'add rest of the fields:
    Do Until rst.EOF
        i = Me.subfFields.Form!cType
        If i = dbText Then
            Set fld = tbl.CreateField(Me.subfFields.Form!tName, i, Nz(Me.subfFields.Form!tSize, 255))
        Else
            Set fld = tbl.CreateField(Me.subfFields.Form!tName, i)
        End If
        tbl.Fields.Append fld
        If Me.subfFields.Form!cControl = 111 Then
            SetDAOProperty fld, "DisplayControl", dbInteger, acComboBox
        End If
        rst.MoveNext
    Loop
End Sub


Sub SetDAOProperty(WhichObject As Field, PropertyName As String, PropertyType As Integer, PropertyValue As Variant)
Dim prp As DAO.Property
    On Error GoTo ErrorHandler
    WhichObject.Properties(PropertyName) = PropertyValue
    WhichObject.Properties.Refresh
Cleanup:
     Set prp = Nothing
     Exit Sub
ErrorHandler:
     Select Case Err.Number
         Case 3270 ' "Property not found"
             Set prp = WhichObject.CreateProperty(PropertyName, PropertyType, PropertyValue)
'=====================================
'the next line throws the error:
'=====================================
             WhichObject.Properties.Append prp
             WhichObject.Properties.Refresh
         Case Else
             MsgBox Err.Number & ": " & Err.Description
     End Select
     Resume Cleanup
End Sub

Can someone explain what is the problem please? Seems like I'm missing something. Is there some kind of syntax error? My native language isn't English.

CodePudding user response:

So as June7 suggested, appending firstly the table and then modifing the field's properties, worked fine.
Here is the final code in case someone needs it:

'create Table:
    Set DB = Application.CurrentDb
    Set tbl = DB.CreateTableDef(Me.tName)
'ID as PK:
    Set fld = tbl.CreateField("ID", dbLong)
    fld.Attributes = dbAutoIncrField
    tbl.Fields.Append fld
    Set indx = tbl.CreateIndex("IDindex")
    indx.Primary = True
    Set fld = indx.CreateField("ID")
    indx.Fields.Append fld
    tbl.Indexes.Append indx
    Set indx = Nothing
    Set fld = Nothing
'add rest of the fields:
    Do Until rst.EOF
        i = Me.subfFields.Form!cType
        If i = dbText Then
            Set fld = tbl.CreateField(Me.subfFields.Form!tName, i, Nz(Me.subfFields.Form!tSize, 255))
        Else
            Set fld = tbl.CreateField(Me.subfFields.Form!tName, i)
        End If
        tbl.Fields.Append fld
        If Me.subfFields.Form!cControl = 111 Then
            SetDAOProperty fld, "DisplayControl", dbInteger, acComboBox
        End If
        rst.MoveNext
    Loop
'append table:
    DB.TableDefs.Append tbl
'format comboboxes:
    rst.MoveFirst
    Do Until rst.EOF
        If Me.subfFields.Form!cControl = 111 Then
            Set fld = tbl.Fields(Me.subfFields.Form!tName)
            SetDAOProperty fld, "DisplayControl", dbInteger, acComboBox
            SetDAOProperty fld, "RowSourceType", dbText, "Value List"
            SetDAOProperty fld, "RowSource", dbText, "Test1;Test2"
            SetDAOProperty fld, "ColumnCount", dbInteger, 2 
            SetDAOProperty fld, "ColumnWidths", dbText, "0;1" 
            SetDAOProperty fld, "ListRows", dbInteger, 4 
            SetDAOProperty fld, "LimitToList", dbBoolean, -1 
            SetDAOProperty fld, "AllowValueListEdits", dbBoolean, 0 
            SetDAOProperty fld, "ShowOnlyRowSourceValues", dbBoolean, -1 
        End If
        rst.MoveNext
    Loop

This answer may be similar to this, but is not a duplicate. The goal is similar but the problem faced(error) is different.

  • Related