AccessVBA

11

tdf2.FindFirst "Кто = 'Алексеев'" End Sub

Sub ЗаписиDAO ()

Set базаДанных = CurrentDb

строкаSQL = "SELECT * FROM Таблица1 WHERE Фирма LIKE 'I*'"

Set результатЗапроса = базаДанных.OpenRecordset (строкаSQL) результатЗапроса.MoveFirst

MsgBox результатЗапроса.Fields (0) & " - " & результатЗапроса.Fields (2)

где = "Фирма = 'Intel'"

результатЗапроса.FindFirst где

MsgBox результатЗапроса.Fields (0) & " - " & результатЗапроса.Fields (2) результатЗапроса.FindNext где

MsgBox результатЗапроса.Fields (0) & " - " & результатЗапроса.Fields (2)

результатЗапроса.MoveLast

MsgBox результатЗапроса.RecordCount

End Sub

Sub ОбновлениеЗаписей ()

Set rst = CurrentDb.OpenRecordset ("Таблица1") где = "Фирма = 'Intel'"

DoCmd.RunSQL _

"UPDATE Таблица1 SET Цена = 5 WHERE NТовара=2" DoCmd.RunSQL _

"UPDATE Таблица1 SET Фирма = 'LG' WHERE " & где DoCmd.RunSQL _

"UPDATE Таблица1 SET Фирма = 'Zilog' WHERE " & _

"Фирма = 'LG'" rst.Close

Set rst = Nothing End Sub

Sub АнализЗаписей ()

Set db = CurrentDb

Set rst = db.OpenRecordset ("Таблица1", dbOpenDynaset) где = "Фирма = 'Intel'"

rst.MoveFirst rst.FindFirst где

If rst.NoMatch = False Then MsgBox "Фирма есть в этой таблице" rst.FindNext где

If rst.NoMatch Then MsgBox "Фирма только одна" rst.Close

db.Close

Set rst = Nothing Set db = Nothing

End Sub

Sub СписокБазыДанных ()

Set текущаяБазаДанных = CurrentDb

Set рабочаяОбласть = DBEngine.Workspaces(0)

Set новаяБазаДанных = рабочаяОбласть.CreateDatabase _ ("Студенты.mdb", dbLangGeneral)

12

Set другаяБазаДанных = рабочаяОбласть.OpenDatabase _ ("ФирмаГодПрезидент")

For Each базаДанных In рабочаяОбласть.Databases

список = список & Chr (13) & базаДанных.Name

Next базаДанных

MsgBox список End Sub

Sub СписокПолей ()

Set db = CurrentDb Set tdf = db!Таблица1

For Each fld In tdf.Fields

строка = строка & Chr (13) & fld.Name

Next fld

MsgBox строка

End Sub

Sub ЗаменаДанных ()

Set объект = CurrentDb.OpenRecordset ("Товары", dbOpenDynaset)

критерий = "NТовара = 1" объект.FindFirst критерий

Do Until объект.NoMatch With объект

.Edit

.NТовара = 333

.Update

.FindNext критерий End With

Loop

объект.Close

Set объект = Nothing

End Sub

Sub ЧтениеДанных ()

‘В Access для загрузки в массив строк объекта Recordset

‘используется метод GetRows

Set объект = CurrentDb.OpenRecordset("Товары") массив = объект.GetRows (объект.RecordCount) For Each элемент In массив

строка = строка & элемент & chr (13)

Next

MsgBox строка End Sub

Sub ПравкаТаблицDAO ()

Set таблица = CurrentDB.OpenRecordset ("Таблица1")

таблица.MoveFirst

таблица.Edit

таблица.Fields (Фирма) = "SCAN" таблица.Fields (Год) = 2005

строкаSQL = "UPDATE Таблица1 SET NТовара = 22 " _

13

& "WHERE NТовара = 2 " CurrentDb.Execute строкаSQL

таблица.AddNew

таблица.Fields (ФИО) = “Новый” таблица.Update

таблица.BookMark = таблица.LastModified

таблица.Move 5

таблица.Delete

таблица.moveNext

End Sub

Процедурное и структурное программирование в ADO

Синтаксис обращения к объектам ADO:

ADODB.имяОбъекта

Для доступа к данным в этой модели используются объекты Connection, несущие сведения об источнике данных и его расположении. Для работы с ним открывается множество Recorddet или Command и задается строка подключения ConnectionString. Значения каждого свойства такого объекта можно задавать как аргумент метода Open или отдельно, через свойство Properties. Connection открывает сеанс обмена данными через провайдера OLEDB. Command служит для выполнения запросов. Recordset представляет набор записей, а Fields — семейство его полей. Отдельные параметры SQLзапросов и хранимых процедур образуют семейство Parameter. Ошибки сеанса связи фиксируются объектами семейства Errors. Как и в DAO, свойства — объекты Properties — делятся на встроенные и динамические. Можно сначала задавать свойства, а потом создавать объект, используя его метод или метод другого объекта. Или наоборот: вначале создать объект, а затем установить значения его свойств.

Свойства и методы классов модели ADODB приведены в таблице.

Объекты Recordset создают тремя методами: Open класса Recordset, Exequte класса Command или Exequte класса Connection. Синтаксис метода Open:

rst.Open Source, Connection, CursorType, lockType, Options

где Source — это имя таблицы или запроса, инструкция SQL, ссылка на объект Command или имя файла, Connection — ссылка на объект подключения, cursorType — тип доступа: adOpenDynamic — отображает все изменения, вставки и удаления, вносимые другими пользователями; adOpenKeyset — показывает только изменения; adOpenStatic — сохраняет исходный набор; adOpenForwardOnly — то же, при одностороннем движении курсора; LockType — тип блокировки: adLockReadOnly — только для чтения,

15

adLockPessimistic — пессимистическая блокировка, adLockOptimistic —

оптимистическая блокировка, adLockBatchOptimistic — с кэшированием изменений в наборе; Options — характеристика Source: adCmdText — инструкция SQL, adCmdTable — SQL-запрос ко всем записям таблицы, adCmdTableDirect — таблица или запрос, adCmdUnknown — без указания параметра, adCmdFile — файл с набором записей.

Объект Command служит для выполнения запросов. В качестве источника данных запроса может задаваться таблица или SQL-инструкция, серверное представление или хранимая процедура. Его свойство CommandType при этом принимает одно из значений: adCmdUnknown — неизвестный, по умолчанию, adCmdText — запрос или хранимая процедура, adCmdTable — таблица для запроса, adCmdTableDirect — непосредственно открываемая таблица, adCmdStoredProc — хранимая процедура на сервере, adCmdFile — файл с набором записей.

Примеры

Sub ТекущееСоединениеADO ()

Dim cnn As ADODB.Connection

Set cnn = CurrentProject.Connection

MsgBox cnn.ConnectionString

If cnn.State = adStateClosed Then

MsgBox "Нет подключения"

Else

MsgBox "Подключение есть"

End If

Set cnn = Nothing

End Sub

Sub Соединение1ADO ()

Dim cnn As ADODB.Connection Set cnn = New ADODB.Connection cnn.Open _

"Provider=SQLOLEDB; Data Source=srv; Initial Catalog=pubs;" & _ "DataBase=базаДанных; User Id=sa; Password=;"

MsgBox cnn.ConnectionString

If cnn.State = adStateClosed Then MsgBox "Нет подключения"

Else

MsgBox "Подключение есть"

End If cnn.Close

End Sub

Sub Соединение2ADO ()

Dim cnn As ADODB.Connection Set cnn = New ADODB.Connection cnn.Provider = "SQLOLEDB"

cnn.Properties ("DataSource") = "Источник"

16

cnn.Properties ("DataBase") = "базаДанных" cnn.Properties ("UserId") = "Пользователь" cnn.Properties ("Password") = "Пароль" cnn.Open

MsgBox cnn.ConnectionString

If cnn.State = adStateClosed Then MsgBox "Нет подключения"

Else

MsgBox "Подключение есть"

End If cnn.Close

End Sub

Sub ДоступКПолямADO ()

Dim rst As New ADODB.Recordset

rst.Open "Сотрудники", CurrentProject.Connection

For i = 0 To rst.Fields.Count - 1

temp = temp & rst.Fields(i).Name & vbCr

Next

MsgBox "Всего полей: " & Str(rst.Fields.Count) & vbCr & temp End Sub

Sub СвойстваADO ()

Dim cnn As New ADODB.Connection, rst As New ADODB.Recordset cnn.Provider = "Microsoft.Jet.OLEDB.4.0"

cnn.Properties ("Data Source") = "D:\ Кадры.mdb" cnn.Open

rst.CursorType = adOpenStatic rst.Open “Сотрудники”, cnn

' вот как можно узнать все свойства класса

For i = 0 To cnn.Properties.Count - 1 Debug.Print cnn.Properties (i).Name

Next End Sub

Public cnnXLS As New ADODB.Connection, _ cnnMDB As New ADODB.Connection, _ cnnDBF As New ADODB.Connection

Public rstXLS As New ADODB.Recordset, _ rstMDB As New ADODB.Recordset, _ rstDBF As New ADODB.Recordset

Sub Соединения ()

Отключение

cnnXLS.Open "DBQ=D:\ Сотрудники.xls;Driver={Microsoft Excel Driver (*.xls)}" RSTOpen "Сотрудники", cnnXLS, rstXLS

cnnDBF.Open "DBQ=D:\;Driver={Microsoft dBase Driver (*.dbf)}" RSTOpen "T", cnnDBF, rstDBF

17

cnnMDB.Open "DBQ=D:\ Кадры.mdb;Driver={Microsoft Access Driver (*.mdb)}" RSTOpen "Сотрудники", cnnMDB, rstMDB

End Sub

Sub RSTOpen (tbl As String, _

cnn As ADODB.Connection, rst As ADODB.Recordset)

MsgBox tbl & " connection: " & cnn.ConnectionString

If cnn.State = adStateClosed Then

MsgBox "Нет подключения к " & tbl

Else

rst.CursorType = adOpenStatic rst.Open tbl, cnn

End If End Sub

Sub Отключение ()

Set cnnXLS = Nothing

Set cnnMDB = Nothing

Set cnnDBF = Nothing

Set rstXLS = Nothing

Set rstMDB = Nothing

Set rstDBF = Nothing

End Sub

Sub ВсеПоля ()

Set базаДанных = CurrentDb Set таблица = базаДанных!t3 For Each поле In таблица.Fields

строка = строка & Chr(13) & поле.Name

Next поле MsgBox строка

End Sub

Sub ТекущаяЗаписьADO ()

Dim rst As New ADODB.Recordset

rst.Open "Сотрудники", CurrentProject.Connection Debug.Print rst.Fields ("Кто"), rst.Fields ("Когда") rst.Close

End Sub

Sub Записи1ADO ()

Dim rst As New ADODB.Recordset

rst.Open "ЗапросСотрудники", CurrentProject.Connection

набор.MoveNext

Debug.Print rst.Fields ("Кто"), rst.Fields ("Когда")

набор.Move 4

Debug.Print rst.Fields ("Кто"), rst.Fields ("Когда") Set rst = Nothing

End Sub

Sub Записи2ADO ()

Dim cnn As New ADODB.Connection, rst As New ADODB.Recordset

19

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

В модели ADO используется отличный от DAO синтаксис поиска:

•объектRecordset.Seek (значенияКлюча, параметрыПоиска)

•Find (Критерии, Пропуск, направлениеПоиска, Старт)

где аргументы указывают массив переменных искомого значения и константный тип сравнения, число пропускаемых строк и направление.

Sub ПравкаADO ()

Dim rst As New ADODB.Recordset

строкаSQL = "SELECT * FROM Сотрудники WHERE Сколько <300" rst.Open строкаSQL, _

CurrentProject.Connection, adOpenDynamic, adLockOptimistic With rst

.MoveLast

.Fields ("Кто") = "Новый"

.Update

.Move -5

.Delete

.Close End With

End Sub

Sub ПоискADO ()

Dim rst As New ADODB.Recordset

rst.Open "Сотрудники", CurrentProject.Connection, _ adOpenStatic, adLockReadOnly

rst.Find "Кто = 'Алексин'"

Debug.Print rst.Fields ("Где"), rst.Fields ("Сколько") rst.Close

End Sub

Sub ПравкаТаблицADO ()

Dim rst As New ADODB.Recordset

With rst

.Open "Сотрудники", CurrentProject.Connection, _ adOpenStatic, adLockOptimistic

.Find "Кто = 'Алексин'"

.Fields ("Зачем") = "Отпуск"

.Update

.Close End With

End Sub

Sub ДобавлениеADO ()

Dim rst As New ADODB.Recordset With rst

20

.Open "Сотрудники", CurrentProject.Connection, _ adOpenDynamic, adLockPessimistic

.Find "Кто = 'Гуринов'"

.Fields ("Зачем") = "Отпуск"

.AddNew

.Fields ("Кто") = "Архипов"

.Update

.Close

End With End Sub

Sub УдалениеADO ()

Dim rst As New ADODB.Recordset

rst.Open "Сотрудники", CurrentProject.Connection, _ adOpenStatic, adLockOptimistic

rst.Find "Кто = 'Гуринов'" rst.Delete adAffectCurrent rst.Update

rst.Close

End Sub

Public Sub УдалениеЗаписиADO()

Dim rst As New ADODB.Recordset

rst.Open "SELECT * FROM Сотрудники " & _

"WHERE Сколько < 200", CurrentProject.Connection, _ adOpenStatic, adLockOptimistic

строка = rst.RecordCount & vbCr

Do While Not rst.EOF

строка = строка & rst!Кто & vbCr rst.MoveNext

Loop

MsgBox строка

строка = UCase (InputBox ("Кого удалить?")) rst.Filter = "Кто = '" & строка & "'"

rst.Delete

rst.UpdateBatch rst.Filter = adFilterNone rst.Requery

строка = "После удаления осталось " & rst.RecordCount & vbCr

Do While Not rst.EOF

строка = строка & rst!Кто & vbCr rst.MoveNext

Loop

MsgBox строка rst.Close

End Sub

Sub ЗапросыADO ()

Dim набор As New ADODB.Recordset

набор.Open "Сотр", CurrentProject.Connection, adOpenStatic, adLockOptimistic

где = "Сколько < 200"

DoCmd.RunSQL _