2
votes

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
1

1 Answers

2
votes

You're almost there, just two changes are needed:

1.

Call SetDAOProperty(myField, "DisplayControl", dbText, acComboBox)

DisplayControl is not a text but an integer property:

Call SetDAOProperty(myField, "DisplayControl", dbInteger, acComboBox)

2.

Here the VBA editor already gives a hint that there is a problem:

Call SetDAOProperty(myField, "RowSourceType", dbText, acvaluelist)

acvaluelist does not exist. RowSourceType is a text property, the correct assignment is:

Call SetDAOProperty(myField, "RowSourceType", dbText, "Value List")

Note: The 2nd one would have been picked up by having Option Explicit at the top of each module. It enforces variable declaration and reports undeclared or misspelled variables/constants at compile time.

To have this automatically in new modules, set the Require Variable Declaration option in the VBA Editor. This is really a must have for VBA development.