I'm trying to work out how to use a create table sub in Access 2016 to add a field that has a control property set to combo box.
Using code I've gleaned from various sources, I've managed to get the following to run, except for the creating a combo box.
The table itself needs to have the combobox set up, as it eventually gets uploaded to SharePoint.
Please help?
Sub maketable()
Dim db As DAO.Database
Dim myTable As DAO.TableDef
Dim myField As DAO.Field
Set db = CurrentDb
Set myTable = db.CreateTableDef("TestTable")
With myTable
.Fields.Append .CreateField("DateD", dbDate)
.Fields.Append .CreateField("Description", dbText)
.Fields.Append .CreateField("Num1", dbDouble)
.Fields.Append .CreateField("Num2", dbDouble)
.Fields.Append .CreateField("yesno", dbBoolean)
.Fields.Append .CreateField("listme", dbText)
End With
db.TableDefs.Append myTable
Set myField = myTable.Fields("DateD")
Call SetDAOProperty(myField, "Format", dbText, "Short Date")
Set myField = myTable.Fields("Num1")
Call SetDAOProperty(myField, "DecimalPlaces", dbByte, 2)
Call SetDAOProperty(myField, "Format", dbText, "Standard")
Set myField = myTable.Fields("listme")
Call SetDAOProperty(myField, "DisplayControl", dbText, acComboBox)
Call SetDAOProperty(myField, "RowSourceType", dbText, acvaluelist)
Call SetDAOProperty(myField, "RowSource", dbText, "Test1;Test2")
Application.RefreshDatabaseWindow
Set myField = Nothing
Set myTable = Nothing
Set db = Nothing
End Sub
Function SetDAOProperty( _
WhichObject As Object, _
PropertyName As String, _
PropertyType As Integer, _
PropertyValue As Variant _
) As Boolean
On Error GoTo ErrorHandler
Dim prp As DAO.Property
WhichObject.Properties(PropertyName) = PropertyValue
WhichObject.Properties.Refresh
SetDAOProperty = True
Cleanup:
Set prp = Nothing
Exit Function
ErrorHandler:
Select Case Err.Number
Case 3270 ' "Property not found"
Set prp = WhichObject.CreateProperty( _
PropertyName, _
PropertyType, _
PropertyValue _
)
WhichObject.Properties.Append prp
WhichObject.Properties.Refresh
SetDAOProperty = True
Case Else
MsgBox Err.Number & ": " & Err.Description
SetDAOProperty = False
End Select
Resume Cleanup
End Function