Answered by:
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,
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
- Edited by RunningManHD Sunday, September 27, 2015 5:38 PM
- Proposed as answer by Edward8520Microsoft contingent staff Monday, September 28, 2015 1:42 AM
- Marked as answer by Edward8520Microsoft contingent staff Wednesday, October 7, 2015 6:58 AM
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
- Edited by RunningManHD Sunday, September 27, 2015 5:38 PM
- Proposed as answer by Edward8520Microsoft contingent staff Monday, September 28, 2015 1:42 AM
- Marked as answer by Edward8520Microsoft contingent staff Wednesday, October 7, 2015 6:58 AM
Sunday, September 27, 2015 5:33 PM