CODE -->

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