none
Add a Value list to an existing table by VBA RRS feed

  • 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,

    Sunday, September 27, 2015 4:02 PM

Answers

  • 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



    Sunday, September 27, 2015 5:33 PM

All replies

  • 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:

    Sunday, September 27, 2015 4:25 PM
  • 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



    Sunday, September 27, 2015 5:33 PM