Public Sub SetProperties()
Dim strCaption As String
Dim strDescription As String
Dim db As DAO.Database
Dim fld As DAO.Field
Dim tdfRead As DAO.tabledef
Dim tdfWrite As DAO.tabledef
Dim prp As DAO.Property
strCaption = "The Caption"
strDescription = "The Description"
Set db = CurrentDb
Set tdfRead = db.TableDefs("Data")
Set tdfWrite = db.TableDefs("Data2")
For Each fld In tdfRead.Fields
For Each prp In fld.Properties
If prp.Name = "Description" Or prp.Name = "Caption" Then
Debug.Print prp.Name
AddPropertyToDestination prp.Name, prp.Value, fld.Name, tdfWrite
End If
Next prp
Next fld
End Sub
Public Sub AddPropertyToDestination(propName As String, propvalue As String, fldName As String, tdf As DAO.tabledef)
Const ErrPropExists = 3367
Dim fld As DAO.Field
Dim prp As DAO.Property
On Error GoTo errLbl
'Find matching field in destination table
For Each fld In tdf.Fields
If fld.Name = fldName Then
Set fld = tdf.Fields(fldName)
'assume only creating text properties
Set prp = fld.CreateProperty(propName, dbText, propvalue)
fld.Properties.Append prp
Exit For
End If
Next fld
Exit Sub
errLbl:
If Err.Number = ErrPropExists Then
Exit Sub
Else
MsgBox Err.Number & Err.Description
End If
End Sub