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.