How to set a User Defined Property for a Field object 
Author Message
 How to set a User Defined Property for a Field object

How to copy the description  property across tables?

I hope this is not an FAQ. If it is please point me to the source.
Thanks to all the VB gurus in advance. <bow>

I am unable to set the Description property of newly created fields
in a JET 2.5 DB table. I am being careful to set the properties of
the field before appending the field  to the fields collection of the
tabledef object. DAO would not even let me add any User Defined
Properties to the properties collection of the field object.
The Jet Programmers guide indicates that the Description property
is a User Defined Property. I am using VB 4.0, 16 bit on
Windows NT 3.51.Here is a sample piece of code.
The following code,
1. Opens the biblio.mdb database
2. Creates a new table "NewTitles" in it.  
3. Copies the definition of each field in the table "Titles"
   into "NewTitles".  
4. If the copy is successful, it prints the properties
   of the field "Title" from both tables to the debug window.  
To run, just copy the code into a new module in a new vb4
project and click F5.

Attribute VB_Name = "Module1"
Option Explicit
Global Const gnMSGBOX_YES = 6                 'return from msgbox
Sub CopyFieldProperties(FrmFld As Field, ToFld As Field)
    Dim j As Integer
    Dim p, q As Property
    'Dim numtocreate As Integer
    'numtocreate = FrmFld.Properties.Count - ToFld.Properties.Count
    On Error GoTo myerr
    'On Error Resume Next
    For j = 0 To FrmFld.Properties.Count - 1
        Set p = FrmFld.Properties(j)
        ToFld.Properties(p.Name).Value = p.Value
    Next j
Exit Sub
If Err.Number = 3270 Then 'property not found
   Set q = FrmFld.CreateProperty(p.Name, p.Type, p.Value)
   ToFld.Properties.Append q
   Resume Next
    'Debug.Print j & ": " & Err.Number & ": " & Err.Description
    Resume Next
End If
End Sub

'this function copies the structure of one table to
'a new table in the same or different database
Function CopyStruct(vFromDB As Database, vToDB As Database, vFromName As
String, vToName As String) As Integer
  On Error GoTo CSErr

  Dim i, j As Integer
  Dim tblTableDefObj As TableDef
  Dim fldFieldObj As Field
  Dim indIndexObj As Index
  Dim tdf As TableDef
  Dim fld As Field
  Dim idx As Index

  'search to see if table exists
'  For Each tdf In vToDB.Tabledefs
  For i = 0 To vToDB.TableDefs.Count - 1
    Set tdf = vToDB.TableDefs(i)
    If UCase(tdf.Name) = UCase(vToName) Then
      If MsgBox(vToName & " already exists, delete it?", 4) =
         vToDB.TableDefs.Delete tdf.Name
         vToName = InputBox("Enter New Table Name:")
         If Len(vToName) = 0 Then
           Exit Function
           GoTo NameSearch
         End If
      End If
      Exit For
    End If

  Set tblTableDefObj = gdbCurrentDb.CreateTableDef()
  tblTableDefObj.Name = vToName

  'create the fields
  For i = 0 To vFromDB.TableDefs(vFromName).Fields.Count - 1
    Set fld = vFromDB.TableDefs(vFromName).Fields(i)
    Set fldFieldObj = vFromDB.TableDefs(vFromName).CreateField(fld.Name,
fld.Type, fld.Size)
    CopyFieldProperties fld, fldFieldObj
    tblTableDefObj.Fields.Append fldFieldObj
  'append the new table
  vToDB.TableDefs.Append tblTableDefObj
  CopyStruct = True
  Exit Function

  MsgBox Error
  CopyStruct = False
  Exit Function

End Function

Sub main()
    Dim dbCurrentDb As Database
    Dim recFrom, recTo As Recordset
    'open database
    Set dbCurrentDb =
    'copy structure
    If CopyStruct(dbCurrentDb, dbCurrentDb, "Titles", "NewTitles") =
True Then
        'print the properties of a field from both tables
        Set recFrom = dbCurrentDb.OpenRecordset("Titles", dbOpenDynaset)
        Set recTo = dbCurrentDb.OpenRecordset("NewTitles",
        PrintProps recFrom.Fields("Title")
        PrintProps recTo.Fields("Title")
        MsgBox "Failed"
    End If
End Sub

Sub PrintProps(fld As Field)
Dim i As Integer
Dim s As String

On Error Resume Next
Debug.Print "----" & " Properties of field " & fld.Name & _
      " from table " & fld.SourceTable & " ----"
For i = 0 To fld.Properties.Count - 1
    s = i & ": "
    s = s & fld.Properties(i).Name & ": "
    s = s & fld.Properties(i).Value
    Debug.Print s
Next i
End Sub

'Padma Indraganti

'Hughes Space and Communications
'El Segundo, CA 90009

Sun, 04 Jul 1999 03:00:00 GMT  
 [ 1 post ] 

 Relevant Pages 

1. How to set a User Defined Property for a Field object

2. Set Nothing to user-defined Image property through Properties Window

3. How to set Nothing to user-defined Image in property box

4. Defining a set of choices in a property of a user control

5. Defining a set of choices in a property of a user control

6. Defining a set of choices in a property of a user control

7. Array as Property or Field in User Defined Class

8. Help adding a user defined property to a field using vb5 and DOA

9. How to test (or set) value of user defined yes/no field

10. User-defined types as properties of objects?

11. User defined type for object properties

12. How to create USER DEFINED PROPERTY for Jet objects with ADO


Powered by phpBB® Forum Software