Add a Value list to an existing table by VBA

Question

I have a table in my back-end database named "tblUser". I want to add a field to it that be like combo box and have three value (list-value) "Edit","View"; "Deny". How I can create this type of fields and add these values to this field. I want to do this by VBA.

Regards,

---

Regards,

Answer 1

First of all: While it's possible to do that, it wil result in performace issues. Cause when working with that table that control is not everytime but often evaluated.

Consider using a lookup table to define the possible values or use a check constraint which only allows those values. Otherwise you may have later unexpected values in that column. Then create a lookup:

Answer 2

Give this a try:

Option Compare Database
Option Explicit

Enum gcRowSourceType
    gcValueList = 1
    gcFielList = 2
    gcTableList = 3
End Enum

Public Function CreateFieldAndLookup(TableName As String, FieldName As String, RowSourceType As gcRowSourceType, RowSource As String, ColumnCount As Integer, ColumnWidths As String, Optional DatabaseFile As String) As Boolean

    On Error GoTo Err_Process
    
    Dim dbs1 As DAO.Database
    Dim fld1 As DAO.Field
    Dim prp1 As DAO.Property
    Dim tdf1 As DAO.TableDef
    Dim strRowSourceType As String
    Dim blnReturn As Boolean

    blnReturn = False
    
    Select Case RowSourceType
    Case gcValueList    '= 1
        strRowSourceType = "Value List"
    Case gcFielList     '= 2
        strRowSourceType = "Field List"
    Case gcTableList    '= 3
        strRowSourceType = "Table/Query"
    End Select
    
    If (DatabaseFile <> "") Then
        Set dbs1 = OpenDatabase(DatabaseFile)
    Else
        Set dbs1 = CurrentDb
    End If
    
    Set tdf1 = dbs1.TableDefs(TableName)
    
    Set fld1 = tdf1.CreateField(FieldName, dbLong)
    tdf1.Fields.Append fld1
    
    Set prp1 = fld1.CreateProperty("DisplayControl", dbInteger, acComboBox)
    fld1.Properties.Append prp1
    
    Set prp1 = fld1.CreateProperty("RowSourceType", dbText, strRowSourceType)
    fld1.Properties.Append prp1
    
    Set prp1 = fld1.CreateProperty("RowSource", dbText, RowSource)
    fld1.Properties.Append prp1
    
    Set prp1 = fld1.CreateProperty("ColumnCount", dbInteger, ColumnCount)
    fld1.Properties.Append prp1
    
    Set prp1 = fld1.CreateProperty("ColumnWidths", dbText, ColumnWidths)
    fld1.Properties.Append prp1
    
    If (DatabaseFile <> "") Then
        dbs1.Close
    End If

    blnReturn = True

Exit_Process:
    Set dbs1 = Nothing
    Set fld1 = Nothing
    Set prp1 = Nothing
    Set tdf1 = Nothing
    CreateFieldAndLookup = blnReturn
    Exit Function
    
Err_Process:
    MsgBox Err.Number & " " & Err.Description, vbExclamation, "Error"
    Resume Exit_Process
    Resume 0
    
End Function

Function TestCreateFieldAndLookup()
    
    Dim blnStatus As Boolean
    
    blnStatus = CreateFieldAndLookup("tblUser", "Permission", gcValueList, "1;Edit;2;View;3;Deny", 2, "0")
    
    MsgBox "Field was " & IIf(blnStatus, "was successfully", "was not successfully") & " created.", vbInformation, "Status"
    
End Function

For more information, see Access help on TableDef Object (DAO) or refer to the following link:

https://msdn.microsoft.com/en-us/library/office/ff195790.aspx