Министерство образования и науки РФ
ГОУВПО «Комсомольский-на-Амуре государственный технический университет»
Кафедра МОП ЭВМ
«Передача данных между приложениями по технологии АDО»
Выполнил: Рогозин В.А.
Группа: 4ВС-1
Проверил: Тихомиров В.А.
Комсомольск-на-Амуре
2006
Задание.
Содержание полей на форме: Поле ввода пути к базе данных, список имен таблиц в базе, кнопка вывода строки таблицы и кнопка ввода исправленной строки
Выполняемые действия: Пользователь выбирает нужную таблицу в нужной базе данных и при нажатии кнопки выводит в Excel поля выбранной строки, редактирует данные в полях и второй кнопкой возвращает отредактированную строку в базу.
'Определение глоб переменных
Dim bd As ADODB.Connection
Dim zap As ADODB.Recordset
Dim cmd As ADODB.Command
Dim tbname As String
'Вывод таблицы
Private Sub CommandButton2_Click()
'Открытие базы данных
Set bd = New Connection
bd.Provider = "microsoft.jet.oledb.4.0"
bd.Open TextBox1.Text
Set zap = New ADODB.Recordset
'Получение имени открываемой таблицы
tbname = ListBox1.Text
If (tbname = "") Then
MsgBox "Укажите имя таблицы!", , "Ошибка!"
Exit Sub
End If
'Открытие таблицы
With zap
.ActiveConnection = bd
.CursorType = adOpenDynamic
.LockType = adLockOptimistic
.Open Source:=tbname
End With
A = zap.Fields.Count
zap.MoveFirst
k = 1
Cells.Clear
'Печать таблицы на листе Excel
While (zap.EOF <> True)
For j = 1 To A
Cells(1, j + 1) = zap.Fields(j - 1).name
Cells(1, 1).Offset(k, j) = zap.Fields(j - 1).Value
Cells(k + 1, 1) = k
Next j
k = k + 1
zap.MoveNext
Wend
End Sub
'Обновления строки
Private Sub CommandButton3_Click()
i = Selection.Cells
zap.MoveFirst
'Переход к выбранной строке
zap.Move (i - 1)
'Обновление выбранной строки
A = zap.Fields.Count
For j = 0 To (A - 1)
zap.Fields(j).Value = Cells(i + 1, j + 2)
Next j
zap.MoveFirst
k = 1
'Вывод новой таблицы
While (zap.EOF <> True)
For j = 1 To A
Cells(1, j + 1) = zap.Fields(j - 1).name
Cells(1, 1).Offset(k, j) = zap.Fields(j - 1).Value
Cells(k + 1, 1) = k
Next j
k = k + 1
zap.MoveNext
Wend
End Sub
Private Sub UserForm_Initialize()
TextBox1.Text = "D:\"
End Sub
'Заполнения списка имен таблиц
Private Sub TablesButton1_Click()
Dim tb1 As ADOX.Table
Dim tb2 As ADOX.Catalog
'Открытие каталога
Set tb2 = New ADOX.Catalog
On Error GoTo M1
tb2.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0; " _
& "Data Source=" & TextBox1.Text
ListBox1.Clear
'Вывод таблиц в список
For Each tb1 In tb2.Tables
If tb1.Type = "TABLE" Then
ListBox1.AddItem (tb1.name)
End If
Next
GoTo M2
M1: MsgBox "Укажите имя файла.", , "Ошибка!"
M2: End Sub
Уважаемый посетитель!
Чтобы распечатать файл, скачайте его (в формате Word).
Ссылка на скачивание - внизу страницы.