Private Sub Command1_Click()

'Получаем информацию об определенных полях

Set rs = cn.OpenSchema(adSchemaColumns, Array("pubs", "dbo", "authors"))

While Not rs.EOF

Debug.Print rs!COLUMN_NAME

rs.MoveNext

Wend

End Sub

Private Sub Command2_Click()

'Получаем информацию об основном ключе таблицы.

Set rs = cn.OpenSchema(adSchemaPrimaryKeys, Array("pubs", "dbo", "authors"))

MsgBox rs!COLUMN_NAME

End Sub

Private Sub Command3_Click()

'Получаем информацию обо всех таблицах

Dim criteria(3) As Variant

criteria(0) = "pubs"

criteria(1) = Empty

criteria(2) = Empty

criteria(3) = "table"

Set rs = cn.OpenSchema(adSchemaTables, criteria)

While Not rs.EOF

Debug.Print rs!TABLE_NAME

rs.MoveNext

Wend

End Sub

Private Sub Form_Load()

cn.Open "dsn=pubs;uid=<username>;pwd=<strong password>;"

End Sub

Приведенный ниже пример программы позволяет получить список таблиц в базе данных

Sub Test_STRUCT_table()

' Перед решением необходимо в TOOLS->REFERENCES выбрать

' Microsoft ActiveX Data Objects 2.8

Dim MyCon As New Connection

MyCon.Open "testr"

Set rs = MyCon.OpenSchema(adSchemaTables)

Workbooks("Example_DB.xls").Worksheets("Table_Structure1").Activate

i = 2

While Not rs.EOF

Cells(i, 1).Value = rs!TABLE_NAME

Cells(i, 2).Value = rs!TABLE_CATALOG

Cells(i, 3).Value = rs!TABLE_SCHEMA

Cells(i, 4).Value = rs!TABLE_TYPE

i = i + 1

rs.MoveNext

Wend

MyCon.Close

Cells(1, 1).Value = i - 2

End Sub

Следующая программа показывает как получать информацию о полях таблиц

Sub Test_STRUCT_columns()

' Перед решением необходимо в TOOLS->REFERENCES

' Microsoft ActiveX Data Objects 2.8

Dim MyCon As New Connection

MyCon.Open "testr"

Workbooks("Example_DB.xls").Worksheets("Table_Structure1").Activate

For ii = 2 To Cells(1, 1).Value

Set rs = MyCon.OpenSchema(adSchemaColumns, Array(Empty, Empty, Cells(ii, 1).Text)

i = 2

While Not rs.EOF

Cells(ii, 5 + i).Value = rs!COLUMN_NAME

i = i + 1

rs.MoveNext

Wend

Next ii

MyCon.Close

End Sub