Publish date: 2003-03-21

Table metadata extract (VB)

Download the example archive
'method for extract metadata from table job
'demonstrates how to use Restrictions Columns
'with Connection.OpenSchema method
'it uses methods CreateReport and GetTypeName
Sub Sample10_2()

    'adding new workbook
    Set work_bk = Application.Workbooks.Add

    Dim con As ADODB.Connection
    Dim rs As ADODB.Recordset

    'open connection to employee.gdb
    Set con = New ADODB.Connection
        con.Open "file name=" & ThisWorkBook.Path & "\employee.ibp"
        con.BeginTrans

        'extract metadata for table JOB
        'use OpenSchema method with Criterias (Array(Restrictions fields))

        'columns by table Job (TABLE_NAME Criteria)
        Set rs = con.OpenSchema(adSchemaColumns, Array(Empty, Empty, "JOB"))
        Call CreateReport(rs, "COLUMNS")

        'get domains for job_code column (COLUMN_NAME Criteria)
        Set rs = con.OpenSchema(adSchemaColumnsDomainUsage, Array(Empty, Empty, Empty, "JOB_CODE"))
        Call CreateReport(rs, "DOMAIN FOR JOB_CODE")

        'constraints in table JOB

        'primary keys (TABLE_NAME Criteria)
        Set rs = con.OpenSchema(adSchemaPrimaryKeys, Array(Empty, Empty, "JOB"))
        Call CreateReport(rs, "PRIMARY_KEYS")

        'foreign keys (TABLE_NAME Criteria)
        Set rs = con.OpenSchema(adSchemaForeignKeys, Array(Empty, Empty, "JOB"))
        Call CreateReport(rs, "FOREIGN_KEYS")

        'check (TABLE_NAME and CONSTRAINT_TYPE Criteria)
        Set rs = con.OpenSchema(adSchemaTableConstraints, Array(Empty, Empty, Empty, Empty, Empty, "JOB", "CHECK"))
        Call CreateReport(rs, "CONSTRAINTS")

        'uniq constraints not presented in JOB table
        'we use project table for get uniq constraint
        '(TABLE_NAME and CONSTRAINT_TYPE Criteria)

        '(for example uncomment two next instructions)
        'Set rs = con.OpenSchema(adSchemaTableConstraints, Array(Empty, Empty, Empty, Empty, Empty, "JOB", "CHECK"))
        'Call CreateReport(rs, "UNIQ CONSTRAINTS FOR PROJECT")

        'indexes
        Set rs = con.OpenSchema(adSchemaIndexes, Array(Empty, Empty, Empty, Empty, "JOB"))
        Call CreateReport(rs, "INDEXES FOR JOB TABLE")

        con.CommitTrans
        con.Close
End Sub

'call OpenSchema and set worksheet name
Private Sub MOpenSchema(MSchemaEnum As SchemaEnum, NameSheet As String, Optional Criteria As Variant = Nothing)
    If Not Criteria Is Nothing Then
       Set rs = con.OpenSchema(MSchemaEnum, Criteria)
    Else
       Set rs = con.OpenSchema(MSchemaEnum)
    End If

    CreateReport rs, NameSheet
End Sub
'place Recordset to the worksheet
Public Sub CreateReport(rs As ADODB.Recordset, NameSheet As String)

    'current worksheet
    Dim cur_worksheet As Worksheet
    Dim i As Integer

    'max records per sheet
    Dim max_rec As Long

    'current row
    Dim currow As Long
    currow = 1

    'find worksheet if exist
    For i = 1 To work_bk.Worksheets.Count
        If work_bk.Worksheets(i).Name = NameSheet Then
           Set cur_worksheet = work_bk.Worksheets(i)
           Exit For
        End If
    Next i

    'if wotksheet not exist in workbook adding new worksheet
    If cur_worksheet Is Nothing Then
       'adding workshet to the end of worksheets list
       Set cur_worksheet = work_bk.Worksheets.Add(after:=work_bk.Worksheets(work_bk.Worksheets.Count))
       cur_worksheet.Name = NameSheet
    Else
       'else clear finded worksheet
       cur_worksheet.Cells.Clear
    End If

    With cur_worksheet
         Do While Not rs.EOF
            'process events
            DoEvents

            For i = 0 To rs.Fields.Count - 1
                'place on error because some OLE DB types not presented in VARIANT
                '(for example UI8 type)
                On Error Resume Next
                      .Cells(currow, 3) = rs.Fields(i).Value
                      .Cells(currow, 1) = rs.Fields(i).Name
                      'type get from DataTypeEnum
                      .Cells(currow, 2) = GetTypeName(rs.Fields(i).Type)

                      'don't print error values
                      If Err.Description = "" Then
                         currow = currow + 1
                         Err.Clear
                      End If
                On Error GoTo 0
            Next i
            'max record count
            max_rec = max_rec + 1

            'increment current row
            currow = currow + 1
            rs.MoveNext

            'if MaxRecords <>0 then check for max avalible records per sheet
            If MaxRecords > 0 Then
               If max_rec >= MaxRecords Then Exit Do
            End If
         Loop

         .Columns.AutoFit
         .Rows.AutoFit

    End With
End Sub

'return type name by id from DataTypeEnum
Private Function GetTypeName(datatp As Long) As String

    Select Case datatp
           Case adWChar
                GetTypeName = "adWChar"
           Case adVarWChar
                GetTypeName = "adVarWChar"
           Case adVarNumeric
                GetTypeName = "adVarNumeric"
           Case adVariant
                GetTypeName = "adVariant"
           Case adVarChar
                GetTypeName = "adVarChar"
           Case adVarBinary
                GetTypeName = "adVarBinary"
           Case adUserDefined
                GetTypeName = "adUserDefined"
           Case adUnsignedTinyInt
                GetTypeName = "adUnsignedTinyInt"
           Case adUnsignedSmallInt
                GetTypeName = "adUnsignedSmallInt"
           Case adUnsignedInt
                GetTypeName = "adUnsignedInt"
           Case adUnsignedBigInt
                GetTypeName = "adUnsignedBigInt"
           Case adTinyInt
                GetTypeName = "adTinyInt"
           Case adSmallInt
                GetTypeName = "adSmallInt"
           Case adSingle
                GetTypeName = "adSingle"
           Case adPropVariant
                GetTypeName = "adPropVariant"
           Case adNumeric
                GetTypeName = "adNumeric"
           Case adLongVarWChar
                GetTypeName = "adLongVarWChar"
           Case adLongVarChar
                GetTypeName = "adLongVarChar"
           Case adLongVarBinary
                GetTypeName = "adLongVarBinary"
           Case adIUnknown
                GetTypeName = "adIUnknown"
           Case adInteger
                GetTypeName = "adInteger"
           Case adIDispatch
                GetTypeName = "adIDispatch"
           Case adGUID
                GetTypeName = "adGUID"
           Case adFileTime
                GetTypeName = "adFileTime"
           Case adError
                GetTypeName = "adError"
           Case adEmpty
                GetTypeName = "adEmpty"
           Case adDouble
                GetTypeName = "adDouble"
           Case adDecimal
                GetTypeName = "adDecimal"
           Case adDBTimeStamp
                GetTypeName = "adDBTimeStamp"
           Case adDBTime
                GetTypeName = "adDBTime"
           Case adDBDate
                GetTypeName = "adDBDate"
           Case adDate
                GetTypeName = "adDate"
           Case adCurrency
                GetTypeName = "adCurrency"
           Case adChar
                GetTypeName = "adChar"
           Case adChapter
                GetTypeName = "adChapter"
           Case adBSTR
                GetTypeName = "adBSTR"
           Case adBoolean
                GetTypeName = "adBoolean"
           Case adBinary
                GetTypeName = "adBinary"
           Case adBigInt
                GetTypeName = "adBigInt"
           Case adArray
                GetTypeName = "adArray"
           Case Else
                GetTypeName = "Not a Type"
    End Select

End Function
Download the example archive