遍历数据库的表结构

 

' ----------------------------------------------
' ------------------- Access -------------------
' ----------------------------------------------
' //Access中的系统表MSysobjects存储属性的字段是二进制格式，不能直接分析
' //可以采用ADO自带的OpenSchema方法获得相关信息

   ' //conn: 数据库连接
   ' //po: TableName
   ' //DBCon:TADOConnection
   ' /ds:TADODataSet
  
' --表信息
'   DBCon.OpenSchema(siTables, VarArrayOf([Null, Null, 'Table']), EmptyParam, ds);

' --列信息
'   DBCon.OpenSchema(siColumns, VarArrayOf([Null, Null, 'po']), EmptyParam, ds);
  
' --主键
'   DBCon.OpenSchema(siPrimaryKeys, EmptyParam, EmptyParam, ds);
  
' --主键、外键对照
'   DBCon.OpenSchema(siForeignKeys, EmptyParam, EmptyParam, ds);

Dim  rsTable  As  ADODB.Recordset
Dim  rsCol  As  ADODB.Recordset
Dim  sql  As   String
Dim  c, r, i  As   Integer
Dim  DataType  As   String

     Set  rsTable  =   New  ADODB.Recordset
     Set  rsCol  =   New  ADODB.Recordset
    
     ' 读取数据库的所有表信息
     Set  rsTable  =  conn.OpenSchema(adSchemaTables)
    
    c  =   0
    r  =   1
    
     With  vsgrid
        .Rows  =   1
        .Cols  =   30
         '  显示表的属性
         For  i  =   0   To  rsTable.Fields.Count  -   1
            .TextMatrix(.Rows  -   1 , i)  =  rsTable.Fields.Item(i).Name
         Next
        .Rows  =  .Rows  +   1
        
      Do   While   Not  rsTable.EOF
         '  显示各表属性值
         For  i  =   0   To  rsTable.Fields.Count  -   1
             If   IsNull (rsTable(i))  Then
            .TextMatrix(.Rows  -   1 , i)  =   ""
             Else
             .TextMatrix(.Rows  -   1 , i)  =   CStr (rsTable(i))
             End   If
         Next
        
             ' 显示字段属性
            .Rows  =  .Rows  +   1
             Set  rsCol  =  conn.OpenSchema(adSchemaColumns,  Array ( Empty ,  Empty ,  CStr (rsTable( " TABLE_NAME " )),  Empty ))
             For  i  =   0   To  rsCol.Fields.Count  -   1
                .TextMatrix(.Rows  -   1 , i)  =  rsCol.Fields.Item(i).Name
             Next
           .Rows  =  .Rows  +   1
           
             Do   While   Not  rsCol.EOF
                 ' 显示字段属性值
                 For  i  =   0   To  rsCol.Fields.Count  -   1
                     If   IsNull (rsCol(i))  Then
                        .TextMatrix(.Rows  -   1 , i)  =   ""
                     Else
                        .TextMatrix(.Rows  -   1 , i)  =   CStr (rsCol(i))
                        
                         If   CStr (rsCol(i).Name)  =   " DATA_TYPE "   Then
                             Select   Case   CInt (rsCol( " DATA_TYPE " ))
                                 Case   2 : DataType  =   " SmallInt "
                                 Case   3 : DataType  =   " Long Integer "
                                 Case   4 : DataType  =   " Single "
                                 Case   5 : DataType  =   " Double "
                                 Case   6 : DataType  =   " Currency "
                                 Case   7 : DataType  =   " Date "
                                 Case   11 : DataType  =   " Boolean "
                                 Case   12 : DataType  =   " Variant "
                                 Case   13 : DataType  =   " IUnknown "
                                 Case   129 : DataType  =   " Char "
                                 Case   130 : DataType  =   " WChar "
                                 Case   131 : DataType  =   " Numeric "
                                 Case   132 : DataType  =   " UserDefined "
                                 Case   133 : DataType  =   " DBDate "
                                 Case   134 : DataType  =   " DBTime "
                                 Case   135 : DataType  =   " DBTimeStamp "
                                 Case   200 : DataType  =   " VarChar "
                                 Case   201 : DataType  =   " LongVarChar "
                                 Case   202 : DataType  =   " VarWChar "
                                 Case   204 : DataType  =   " VarBinary "
                                 Case   205 : DataType  =   " LongVarBinary "
                                 Case   Else : DataType  =   " Unknown "
                             End   Select
                            .TextMatrix(.Rows  -   1 , i)  =  DataType
                         End   If

                     End   If
                 Next
                rsCol.MoveNext
                .Rows  =  .Rows  +   1
             Loop
            rsCol.Close
        rsTable.MoveNext
        .Rows  =  .Rows  +   1
      Loop
End   With