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 strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Create a table of - table names - fields- etc 2

Status
Not open for further replies.

jgarry

Programmer
Nov 23, 2004
67
US
Hi, thanks in advance, I want to create a table of my current dbf that contains
1 the table name
2 fields within the table
3 Field Size, format, input mast caption etc. all the filed information.

The reason is becase I am creating an upgrade to a product that has many versions. I want to level the versions I. I need to know what tables need updating and which ones dont. any suggestions: I have a routine I got off this site? (i think) that give me table name and fields but nothing else

Function BuildTableNamesList()
Dim strSql As String
Dim strName As String
Dim strFSql As String
Dim strField As String
Dim tjDb As DAO.Database
Dim tjTab As DAO.TableDef
Dim tjfld As DAO.Field

strSql = "insert into tbl_tableList (t_name) values( " & "'" & strName & "');"
' strFSql = "insert into tbl_FieldsList(t_key, f_name) values ( " & "'" & numKey & "'" & "'" & strField & "');"

Set tjDb = CurrentDb

For Each tjTab In tjDb.TableDefs
If (tjTab.Attributes And dbSystemObject) = 0 Then
strName = tjTab.NAME
If strName <> "tbl_TableList" Or strName <> "tbl_FieldsList" Then
strSql = "insert into tbl_tableList (t_name) values ( " & "'" & strName & "');"
DoCmd.RunSQL (strSql)
For Each tjfld In tjTab.Fields
strField = tjfld.NAME
strFSql = "Insert into tbl_FieldsList (f_file, f_name) values (" & "'" & strName & "'," & "'" & [strField] & "');"
DoCmd.RunSQL (strFSql)
Next
End If
End If
Next
tjDb.Close
Set tjTab = Nothing
Set tjDb = Nothing
End Function


Im not sure what else to add to get the individul field information.

Thanks
Jim

 
Here's a routine that I use to build images of tables from other tables.
Code:
Private Sub CreateTheTable(TableName As String, _
                           NewTableName As String, _
                           SourceDB As DAO.DataBase, _
                           DestDB   As DAO.Database)
                       
Dim tblSource                   As DAO.TableDef
Dim tblNew                      As DAO.TableDef
Dim fldSource                   As DAO.Field
Dim fldNew                      As DAO.Field
Dim IdxSource                   As DAO.Index
Dim IdxNew                      As DAO.Index
Dim prp                         As DAO.Property


Set tblSource = SourceDB.TableDefs(TableName)
Set tblNew = New DAO.TableDef
tblNew.Name = NewTableName

For Each fldSource In tblSource.Fields
    Set fldNew = New DAO.Field
    fldNew.Name = fldSource.Name
    fldNew.Type = fldSource.Type
    If fldSource.Type = dbText Then
        fldNew.Size = fldSource.Size
        fldNew.Properties("AllowZeroLength").Value = _
        fldSource.Properties("AllowZeroLength").Value
    End If
    tblNew.Fields.Append fldNew
Next

For Each IdxSource In tblSource.Indexes
    Set IdxNew = tblNew.CreateIndex(IdxSource.Name)
    IdxNew.Name = IdxSource.Name
    IdxNew.Primary = IdxSource.Primary
    IdxNew.IgnoreNulls = IdxSource.IgnoreNulls
    For Each fldSource In IdxSource.Fields
        IdxNew.Fields.Append IdxNew.CreateField(fldSource.Name)
    Next
    tblNew.Indexes.Append IdxNew
Next

DestDB.TableDefs.Append tblNew

End Sub
You may want to fool around with the properties collection for the fields if there are other properties that you need to set.
 
thanks, I just found this also

Function TableInfo()
'(strTableName As String)
On Error GoTo TableInfoErr
' Purpose: Display the field names, types, sizes and descriptions for a table.
' Argument: Name of a table in the current database.

Dim strTableName As String

Dim db As DAO.Database
Dim rs As DAO.Recordset

Dim tdf As DAO.TableDef
Dim fld As DAO.Field

Dim str_table As String
Dim str_field As String
Dim str_Type As String
Dim int_Size As Integer
Dim str_Desc As String
Dim strName As String



Set db = CurrentDb()

' Set tdf = db.TableDefs(strTableName)

Set rs = db.OpenRecordset("aa_tables")

For Each tdf In db.TableDefs
If (tdf.Attributes And dbSystemObject) = 0 Then
strName = tdf.Name
If strName <> "AA_Tables" Then
For Each fld In tdf.Fields
With rs
.AddNew
!tablename = strName
!FieldName = fld.Name
!fieldType = FieldTypeName(fld)
!FieldSize = fld.Size
!fieldDescription = GetDescrip(fld)
.Update
End With
Next
End If
End If
Next



TableInfoExit:
Set rs = Nothing
Set db = Nothing
Exit Function

TableInfoErr:
Select Case Err
Case 3265& 'Table name invalid
MsgBox strTableName & " table doesn't exist"
Case Else
' MsgBox ("TableInfo() Error " & Err & ": " & Error)
End Select
Resume Next
End Function


Function GetDescrip(obj As Object) As String
On Error Resume Next
GetDescrip = obj.Properties("Description")
End Function


Function FieldTypeName(fld As DAO.Field) As String
'Purpose: Converts the numeric results of DAO Field.Type to text.
Dim strReturn As String 'Name to return

Select Case CLng(fld.Type) 'fld.Type is Integer, but constants are Long.
Case dbBoolean: strReturn = "Yes/No" ' 1
Case dbByte: strReturn = "Byte" ' 2
Case dbInteger: strReturn = "Integer" ' 3
Case dbLong ' 4
If (fld.Attributes And dbAutoIncrField) = 0& Then
strReturn = "Long Integer"
Else
strReturn = "AutoNumber"
End If
Case dbCurrency: strReturn = "Currency" ' 5
Case dbSingle: strReturn = "Single" ' 6
Case dbDouble: strReturn = "Double" ' 7
Case dbDate: strReturn = "Date/Time" ' 8
Case dbBinary: strReturn = "Binary" ' 9 (no interface)
Case dbText '10
If (fld.Attributes And dbFixedField) = 0& Then
strReturn = "Text"
Else
strReturn = "Text (fixed width)" '(no interface)
End If
Case dbLongBinary: strReturn = "OLE Object" '11
Case dbMemo '12
If (fld.Attributes And dbHyperlinkField) = 0& Then
strReturn = "Memo"
Else
strReturn = "Hyperlink"
End If
Case dbGUID: strReturn = "GUID" '15

'Attached tables only: cannot create these in JET.
Case dbBigInt: strReturn = "Big Integer" '16
Case dbVarBinary: strReturn = "VarBinary" '17
Case dbChar: strReturn = "Char" '18
Case dbNumeric: strReturn = "Numeric" '19
Case dbDecimal: strReturn = "Decimal" '20
Case dbFloat: strReturn = "Float" '21
Case dbTime: strReturn = "Time" '22
Case dbTimeStamp: strReturn = "Time Stamp" '23

'Constants for complex types don't work prior to Access 2007.
Case 101&: strReturn = "Attachment" 'dbAttachment
Case 102&: strReturn = "Complex Byte" 'dbComplexByte
Case 103&: strReturn = "Complex Integer" 'dbComplexInteger
Case 104&: strReturn = "Complex Long" 'dbComplexLong
Case 105&: strReturn = "Complex Single" 'dbComplexSingle
Case 106&: strReturn = "Complex Double" 'dbComplexDouble
Case 107&: strReturn = "Complex GUID" 'dbComplexGUID
Case 108&: strReturn = "Complex Decimal" 'dbComplexDecimal
Case 109&: strReturn = "Complex Text" 'dbComplexText
Case Else: strReturn = "Field type " & fld.Type & " unknown"
End Select

FieldTypeName = strReturn
End Function

I like your becase it cycles through the Index. Thanks for your assistance

Jim


 
Oh yes I forgot to say Thank you.
So Thank you

Jim
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top