ADOX в ACCESS

osmor

Использование ADOX для работы с файлами MS ACCESS (MDB)

C приходом ADO на смену DAO, многие программисты ACCESS пришли в замешательство, а как без DAO создавать таблицы? как получить доступ у запросам?
Эта статья отвечает на эти вопросы.

Вся информация, изложенная в данной статье, найдена в MSDN.

Полное название ADOX - Microsoft ActiveX Data Objects Extensions for Data Definition Language and Security.

Из названия видно, что эта библиотека является расширением ADO для Data Definition Language (DDL - языка определения данных), который позволяет получить доступ к объектам БД и безопасности.

Мы не будем останавливаться на общих вопросах использования ADOX, а сразу перейдем к тому, что нам дает использование ADOX непосредственно в ACCESS.

И так, ADOX позволяет получить информацию о таблицах их полях, индексах и ключах, сохраненных запросах, пользователях и группах, а так же создавать, изменять и удалять эти объекты БД ACCESS.
ADOX НЕ позволяет получить информацию о формах, отчетах, макросах, страницах доступа к данным и модулях БД ACCESS.

Объектная модель ADOX представляет собой следующую иерархию объектов и коллекций:

[Image]

Подробную информацию о каждом объекте можно найти в MSDN:
(http://msdn.microsoft.com/library/default.asp?url=/library/en-us/ado/html/2fa6237b-44b8-4b6c-9952-5acd80a54e20.asp)

Мы же сразу перейдем к практике.

Чтобы начать работу с ADOX нужно, прежде всего, получить объект Catalog, в MSA сделать это можно двумя способами:

1. Установить ссылку на библиотеку "Microsoft ADO Ext. 2.8 for DDL and Security" (так называемое раннее связывание), для этого:

  • при редактировании модуля нужно открыть меню "Tools-References"
  • найти в списке подключаемых библиотек "Microsoft ADO Ext. 2.8 for DDL and Security"
  • поставить "галку" напротив этой библиотеки
  • нажать кнопку "ОК "

Далее для получения объекта Catalog используем следующую конструкцию:
Dim adoxCat As ADOX.Catalog
Set adoxCat = New ADOX.Catalog

или просто :
Dim adoxCat As New ADOX.Catalog

(Все приведенные ниже примеры предполагают использование данного способа)

2. Создание объекта Catalog с использованием процедуры CreateObject. В этом случае, никаких предварительных действий, для использования ADOX, совершать не нужно. Просто в том месте процедуры, где нужно получить Catalog пишем:

Dim adoxCat As Object
Set adoxCat = CreateObject("ADOX.Catalog")

Начало положено, теперь нужно объяснить созданному объекту, с какой именно базой мы собираемся работать. Для этой цели служит свойство ActiveConnection, ему нужно присвоить объект ADODB.Connection или строку подключения.
Например, для работы с объектами текущей БД можно написать:

Set adoxCat.ActiveConnection = CurrentProject.Connection
(используем объект Connection)

или
adoxCat.ActiveConnection = CurrentProject.Connection
(используем дефолтовое свойство объекта Connection)

или

adoxCat.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & CurrentProject.FullName
(используем текстовую строку подключения)

Ну, вот собственно и все, самое сложное уже позади. Теперь используя свойства и методы полученного ADOX.Catalog, который подключен к нужной нам базе, будем работать с объектами БД ACCESS.
Далее приведен код для решения нескольких конкретных задач
(код проверки наличия запроса или таблицы, а так же обработчики ошибок умышленно не включены для упрощения кода, в реальных приложениях все это необходимо добавить):

Option Compare Database
Option Explicit



Public Sub ADOXListTables()
'список всех таблиц БД с указанием типа таблицы
Dim adoxCat As ADOX.Catalog
Dim adoxTbl As ADOX.Table
Dim strType As String
Set adoxCat = New ADOX.Catalog

'получаем ссылку на текущую БД
adoxCat.ActiveConnection = CurrentProject.Connection
' проверяем свойство TYPE у всех объектов Table
   For Each adoxTbl In adoxCat.Tables
     Select Case adoxTbl.Type
      Case "LINK" ' связанная таблица JET
        strType = " - связанная таблица JET"
      Case "TABLE" ' обычная таблица
        strType = " - простая таблица"
      Case "ACCESS TABLE" 'системная таблица ACCESS
        strType = "- системная таблица MSA"
      Case "SYSTEM TABLE" 'системная таблица JET
        strType = " - системная таблица JET"
      Case "PASS-THROUGH" 'Связанная таблица ODBC
        strType = " - Связанная таблица ODBC"
      Case Else ' какая-то другая
        strType = " - какая-то другая таблица"
    End Select
      Debug.Print adoxTbl.Name; strType
   Next
Set adoxCat = Nothing
Set adoxTbl = Nothing
End Sub



Public Sub ADOXCreateLinkTable(strFileName As String, _
                                strTblName As String, _
                                Optional strLinkTblName As String = "")
'создание связанной таблицы MS ACCESS
'strFileName - путь к БД ACCESS, в которой находится таблица
'strTblName - имя таблицы в исходной БД
'strLinkTblName - имя, под которым будет создана связанная таблица
'если strLinkTblName опущено, то создается таблица с именем strFileName
Dim adoxCat As ADOX.Catalog
Dim adoxTbl As New ADOX.Table
Dim strType As String
Set adoxCat = New ADOX.Catalog
'получаем ссылку на текущую БД
adoxCat.ActiveConnection = CurrentProject.Connection
If strLinkTblName = "" Then strLinkTblName = strTblName
With adoxTbl
    .ParentCatalog = adoxCat
    .Name = strLinkTblName 'имя создаваемой таблицы
    'путь к файлу
    .Properties("Jet OLEDB:Link Datasource").Value = strFileName
    'имя таблицы в исходном файле
    .Properties("Jet OLEDB:Remote Table Name").Value = strTblName
    .Properties("Jet OLEDB:Create Link").Value = True
End With
adoxCat.Tables.Append adoxTbl 'добавляем таблицу в БД
Set adoxCat = Nothing
Set adoxTbl = Nothing

End Sub



Public Sub ADOXRefreshLinks(strFileName As String)
'Обновление связей всех связанных таблиц MS ACCESS
'strFileName - путь к БД ACCESS, в которой находятся таблицы
Dim adoxCat As ADOX.Catalog
Dim adoxTbl As ADOX.Table

Set adoxCat = New ADOX.Catalog
adoxCat.ActiveConnection = CurrentProject.Connection

For Each adoxTbl In adoxCat.Tables
' если таблица, связанная таблица JET
    If adoxTbl.Type = "LINK" Then
        adoxTbl.Properties("Jet OLEDB:Link Datasource") = strFileName
    End If
Next
Set adoxCat = Nothing
Set adoxTbl = Nothing
End Sub



Public Sub ADOXCreateTable()
'создание новой таблицы tblOrders с тремя полями:
'idOrder - последовательный счетчик, ключевое поле таблицы
'NumOrder - текстовое, 12 символов, с условием на значение и сообщением об ошибке
'dtOrder - дата, значение по умолчанию равно Date()
'проверка на существование таблицы и обработчик ошибок умышленно не включены для упрощения кода
Dim adoxCat As ADOX.Catalog
Dim adoxTbl As New ADOX.Table
Dim adoxCol As ADOX.Column
Set adoxCat = New ADOX.Catalog
'получаем ссылку на текущую БД
   adoxCat.ActiveConnection = CurrentProject.Connection

 With adoxTbl
    .Name = "tblOrders" 'имя таблицы
    ' создаем новый объект Column (он же поле таблицы)
    Set adoxCol = New ADOX.Column
    With adoxCol
     .ParentCatalog = adoxCat 'ссылка на каталог
     .Name = "id" 'имя поля
     .Type = adInteger 'тип поля
     .Properties("AutoIncrement").Value = True ' будет счетчик
    End With
    .Columns.Append adoxCol, adInteger ' добавляем поле в коллекцию
    'добавляем новый индекс
    .Keys.Append "PrimaryKey", adKeyPrimary, "id"

    'аналогично для всех полей таблицы
    ' поле № заказа
    Set adoxCol = New ADOX.Column
    With adoxCol
     .ParentCatalog = adoxCat
     .Name = "NumOrder"
     .Type = adVarWChar  'тип поля
     .DefinedSize = 12
     .Properties("Description").Value = "№ заказа"
     'условие на значение
     .Properties("Jet OLEDB:Column Validation Rule").Value = "<>'' and not is null"
     'сообщение о нарушении условия на значение
     .Properties("Jet OLEDB:Column Validation Text").Value = "Укажите номер заказа"
    End With
    .Columns.Append adoxCol, adVarWChar

    ' поле дата заказа
    Set adoxCol = New ADOX.Column
    With adoxCol
     .ParentCatalog = adoxCat
     .Name = "dtOrder"
     .Type = adDate 'тип поля
     .Properties("Description").Value = "Дата заказа"
     .Properties("Default").Value = "date()" ' значение по умолчанию
    End With
    .Columns.Append adoxCol, adDate


  'добавляем таблицу в БД
   adoxCat.Tables.Append adoxTbl

 End With
   Set adoxCat = Nothing
   Set adoxTbl = Nothing
   Set adoxCol = Nothing

End Sub


Public Sub ADOXListIndexTbl(strTblName As String)
'список индексов таблицы + некоторые свойства индекса +
'список полей индекса
'strTblName - имя таблицы в БД
Dim adoxCat As ADOX.Catalog
Dim adoxTbl As ADOX.Table
Dim adoxInx As ADOX.Index
Dim adoxCol As ADOX.Column
Set adoxCat = New ADOX.Catalog
adoxCat.ActiveConnection = CurrentProject.Connection

Set adoxTbl = adoxCat.Tables(strTblName)
For Each adoxInx In adoxTbl.Indexes
    With adoxInx
        Debug.Print "_________________________________"
        Debug.Print "Индекс - "; .Name
        Debug.Print "Первичный - "; .PrimaryKey
        Debug.Print "Уникальный - "; .Unique
        Debug.Print "Поля индекса : ";
        For Each adoxCol In .Columns
           Debug.Print adoxCol.Name; "; ";
        Next
        Debug.Print
    End With
Next

End Sub


Прежде чем рассмотреть код для работы с запросами небольшое замечание.
Access не разделяет запросы на View и Procedure, но ADOX разделяет. Теоретически простые Select запросы без параметров должны попадать в коллекцию Views, а все остальные запросы (в том числе и Select c параметрами) в коллекцию Procedures.
На практике, так происходит только с теми запросами, которые Вы создали "руками" в среде MS ACCESS в текущем файле.

ВСЕ запросы, которые Вы импортируете из других баз или создадите программно, попадут в коллекцию Procedures.
http://support.microsoft.com/default.aspx?scid=kb;en-us;252888
Кроме того, есть проблемы при создании запросов в ACCESS 2000:
http://support.microsoft.com/default.aspx?scid=kb;en-us;246213

Public Sub ADOXListQuerys()
'список запросов в базе
Dim adoxCat As ADOX.Catalog
Dim i As Integer
Set adoxCat = New ADOX.Catalog
'получаем ссылку на текущую БД
adoxCat.ActiveConnection = CurrentProject.Connection
With adoxCat
    Debug.Print "запросы в коллекции Views"
    If .Views.Count = 0 Then
        Debug.Print "Нет запросов в коллекции View"
    Else
       For i = 0 To .Views.Count - 1
          Debug.Print .Views(i).Name
        Next
      End If
    Debug.Print "Запросы в коллекции Procedures"
    If .Procedures.Count = 0 Then
        Debug.Print "Нет запросов в коллекции Procedures"
    Else
       For i = 0 To .Procedures.Count - 1
          Debug.Print .Procedures(i).Name
        Next
    End If
End With
End Sub


Public Sub ADOXcreateQuery()
'создание нового запроса
Dim adoxCat As ADOX.Catalog
Dim qdf As ADODB.Command
Set adoxCat = New ADOX.Catalog
adoxCat.ActiveConnection = CurrentProject.Connection
'новый объект Command
Set qdf = New ADODB.Command
'текст запроса
qdf.CommandText = "select * from tblOrders"
'добавляем новый запрос в базу
adoxCat.Views.Append "Новый запрос", qdf
End Sub

Вот и все, как говорится, пишите письма.

 


Страница сайта http://silicontaiga.ru
Оригинал находится по адресу http://silicontaiga.ru/home.asp?artId=6226