Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations SkipVought on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Field Descriptions on TableDefs 2

Status
Not open for further replies.

Parax

Technical User
Jan 29, 2003
41
0
0
GB
I have several fields in several tables that contain a numeric ID representing a contact record in another database (hence not linked) I am in need of creating a method to update this ID in every occurance, I was thinking of

For Each tbl In CurrentDb.TableDefs
For Each fld In tbl.Fields
If fld.description = "ContactID" Then
'replace goes code here
End If
Next
Next

However the description is not available, and there is no tag as on form controls, does anyone have any suggestions??

there are several instances in each table so I cannot set the each field name as contactID, I really do not want to have to write an update query for 40-odd tables, and then every time a new table is added have to write new queries too.

does anyone know of a way of solving this?
 
Actually, it is possible to get this description. If you walk through the Properties of each field until you find a property with a name of "Description", the Value of that property is the description that you gave the field.

For example:

For intIndex = 0 to fld.Properties.Count - 1
If fld.Properties(intIndex).Name = "Description" Then
Debug.Print fld.Properties(intIndex).Value
End If
Next intIndex

will print the description that you entered for the field when you were in Design mode for the table.
 
A field's description is a property, i.e. from your code snippet:

For Each tbl In CurrentDb.TableDefs
For Each fld In tbl.Fields
If fld.Properties("Description") = "ContactID" Then
'replace goes code here
End If

Next fld
Next tbl

Problem being that if the fld.Properties("Description") = " ",
Access will generate Error Code 3270 - Object not found
for which you must then compensate.

The following is working code that creates tblFields and
populates it with field information for each table in your
database. In the case of Description, if the code finds a
blank Description property, it fills it with "No description provided."
and moves on.

Hopefully this will be sufficient example to allow you to
modify your code as needed. If not, please post back.
Code:
Sub GetField2Description()
' This procedure:
' (1) deletes and recreates a table (tblFields)
' (2) uses a query of (table) MSysObjects to
'     get the names of all tables and linked tables in the
'     database
' (3) Populates tblFields with info about each field

Dim db As DATABASE, td As TableDef
Dim rs As Recordset, rs2 As Recordset
Dim test As String, namehold As String
Dim typehold As String, SizeHold As String
Dim fieldName As String
Dim fielddesc As String, tname As String
Dim n As Long, i As Long, recis As Variant
Dim found As Boolean, prpNew As Property
Dim fld As Field, strSQL As String, ordHold As Integer
n = 0
Set db = CurrentDb
' Trap for any errors.
    On Error Resume Next
tname = "tblFields"
'Does table "tblFields" exist?  If true, delete it;
found = False
test = db.TableDefs(tname).Name
If Err <> 3265 Then
   found = True
   docmd.DeleteObject acTable, &quot;tblFields&quot;
End If
'Create new tblTable
db.Execute &quot;CREATE TABLE tblFields(Object TEXT (55), FieldName TEXT (55), FieldDesc TEXT (55), FieldType TEXT (20), FieldSize Long, FieldAttributes Long, FieldOrd Long);&quot;

strSQL = &quot;SELECT MSysObjects.Name, MSysObjects.Type From MsysObjects WHERE&quot;
strSQL = strSQL + &quot;((MSysObjects.Type)=1)&quot;
strSQL = strSQL + &quot;ORDER BY MSysObjects.Name;&quot;

Set rs = db.OpenRecordset(strSQL)
n = 0
If Not rs.BOF Then
   ' Get number of records in recordset
   rs.MoveLast
   n = rs.RecordCount
   rs.MoveFirst
End If

Set rs2 = db.OpenRecordset(&quot;tblFields&quot;)

For i = 0 To n - 1
  fielddesc = &quot; &quot;
  Set td = db.TableDefs(i)
    'Skip over any MSys objects
    If Left(rs!Name, 4) <> &quot;MSys&quot; Then
       namehold = rs!Name
       found = False
       On Error Resume Next
       For Each fld In td.Fields
          fieldName = fld.Name
          fielddesc = fld.Properties(&quot;Description&quot;)
          If Err = 3270 Or fielddesc = &quot; &quot; Then  '3270 = object not found
             fielddesc = &quot;No description provided.&quot;
          End If
          Err = 0
          typehold = FieldType(fld.Type)
          SizeHold = fld.Size
          rs2.AddNew
          rs2!Object = namehold
          rs2!fieldName = fieldName
          rs2!fielddesc = fielddesc
          rs2!FieldType = typehold
          rs2!FieldSize = SizeHold
          rs2!FieldAttributes = fld.Attributes

          rs2.Update
       Next fld
  
       Resume Next
    End If
    rs.MoveNext
Next i
rs.Close
rs2.Close
db.Close
End Sub

Function FieldType(intType As Integer) As String

Select Case intType
    Case dbBoolean
        FieldType = &quot;dbBoolean&quot;
    Case dbByte
        FieldType = &quot;dbByte&quot;
    Case dbInteger
        FieldType = &quot;dbInteger&quot;
    Case dbLong
        FieldType = &quot;dbLong&quot;
    Case dbCurrency
        FieldType = &quot;dbCurrency&quot;
    Case dbSingle
        FieldType = &quot;dbSingle&quot;
    Case dbDouble
        FieldType = &quot;dbDouble&quot;
    Case dbDate
        FieldType = &quot;dbDate&quot;
    Case dbText
        FieldType = &quot;dbText&quot;
    Case dbLongBinary
        FieldType = &quot;dbLongBinary&quot;
    Case dbMemo
        FieldType = &quot;dbMemo&quot;
    Case dbGUID
        FieldType = &quot;dbGUID&quot;
End Select

End Function
 
Thanks for the info I've got it up and running

a star for you both, as you both were heading towards .Properties(&quot;Description&quot;) and that solved the problem =)

 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top