30200-1 (Считывание данных из гостевой книги), страница 2

Оператор Set связывает ссылку на новый объект, имеющий доступ к системному файлу с переменной fs. Также этот оператор связывает ссылку на новый объект fs, в котором открывается файл Myformrstl.htm(См.Рис.12) для чтения ( с помощью оператора Open) с диска F: на локальном компьютере с объектомt xtobj1. Он также связывает rst1 с новым встроенным объектом ADO базы данных. Потом в объекте rst1 открывается таблица “tblContacts” в текущем проекте CurrentProject.Connection.

Цикл Do Until … Loop выполняется до тех пор пока не будет найдена строка, которая находится прямо перед строкой “X_FirstName”. Для этого используется ещё один цикл If …Then … Else … End If, который проверяет является ли читаемая строка txtobj1.ReadLine файла Myformrstl.htm строкой “ X_FirstName ”. Это осуществляется при помощи функции InStr , которая возвращает позицию искомой строки “X_FirstName”. И если она является таковой, то выполняется вторая процедура ProcessContact нашего проекта, если же нет – то продолжается цикл Do ... Loop.

Для очистки ресурсов используется метод Close для объектов txtobj1и rst1 и оператор Set, который ссылается на пустые объекты txtobj1 и rst1.

Для заполнения таблицы “tblContacts” в базе данных была создана процедура ProcessContact.

Оператор On … GoTo в случае ошибки заставляет перепрыгивать программу на строку MyErrorTrap.

Оператор Dim объявляет переменные strFname, strLname, strCName, strSt1, strSt2, strCity, strRegion, strPostalCode, strCountry, strEmailAddr как строковые переменные; intFirst и intLen как числовые переменные и cmd1 как встроенный объект ADO базы банных.

С помощью цикла If …Then … Else … End If в этой процедуре проверяются строки с введёнными данными из Гостевой книги, которые сохранены в файле Myformrstl.htm. Цикл If …Then … Else … End If с помощью функции InStr проверяет наличие в строке специального знака “ ” и если его нет, то присваивает переменной intFirst номер позиции символа + 1, с которого будет производиться запись. Затем переменной intLen присваивается значение длины записи, т.е. сколько символов будет записано – 1. Переменным strFName и strLName присваиваются значения с помощью функций Ucase, Lcase и Mid символа с большой буквы под номером, который присвоен переменной intFirst строки strTemp и символов, с номерами, следующими за intFirst из той же строки, длиной intLen – 1. Если условие не выполняется то строка остаётся пустой.

По такому же принципу переменным strCName, strSt1 и strSt2 присваиваются значения, но при этом вместо функций Ucase, Lcase используется функция CleanText, которая создана в этом проекте. Она убирает все лишние символы из строки.

В присвоении переменным strCity, strRegion, strPostalCode, strCountry, strEmailAddr используются практически те же способы, но вместо цикла If …Then … Else … End If применяется упрощённый цикл, который записывается в одну строку If …Then. И он поверял лишь наличие спецсимволов в очередной строке, и если они есть то Эти переменные остаются пустыми. Также здесь используется только функция Mid и функции Left для strRegion, которая возвращает определённое количество символов с начала строки.

Метод SkipLine объекта txtobj1 пропускает строку.

Для отладки программы используется объект Debug со свойством Print.

Результаты работы процедур появляются в окне отладки.

Далее все считанные данные будут последовательно вписана в таблицу tblContacts нашей базы данных.

Процедура проверяет пустые или нет переменные strFName , strLName и strEmailAddr если нет, то она использует оператор With для объекта rst1 для заполнения полей таблицы, проверяя наличие записи в каждой строковой переменной нашей процедуры.

Метка MyExit в нашей процедуре означает, что после выполнения цикла процедура заканчивает работу.

Каждая стандартная ошибка имеет свой номер. При ошибке – 214721887 объект cmd1 ссылается на новый встроенный объект ADO базы данных и с помощью оператора With связывается с текущим проектом, меняет некоторые свойства этого объекта, выполняет их и за оператором With следует функция восстановления Resume,т.е. запускается с самого начала Sub LookForNameStart. Если же номер ошибки другой , то в окне отладки появляется номер и описание этой ошибки и программа возвращается к метке MyExit.

Функция CleanText убирает специальные символы с помощью функции Replace.

Экранные копии этапов разработки с разъяснениями каждого изображения.

Для выполнения этого проекта необходимо было установить приложение MSFrontPage, который находится в пакете MSOffice2000. Его установочный пакет находится на компьютере User7 нашей локальной сети. При запуске установочного файла мы выбираем “add or remove Features”(См. Рис.1)

Рис.1

Затем мы выбрали FrontPage в списке и дали команду на установление.(См.Рис.2 и Рис.3)

С помощью FrontPage Wizard я создал Гостевую книгу (см.Рис.4), которую потом установили на сервере нашей локальной сети. Получив файл с данными, полученными через эту Гостевую книгу, я приступил к выполнению второй части проекта: создание однотабличной базы данных и написанию кода процедур.

Частью любого проекта VBA является набор ссылок на библиотеку типов всех компонентов IDE, которые применяются в данном проекте. Простые проекты содержат небольшое количество ссылок, которые применяются VBA, интерфейсом автоматизации и базовым приложением. Ссылками можно управлять интерактивно посредствам диалогового окна Ссылки(См.Рис.5) или программным путём, посредствам Rferences класса VBProject.

Рис.2

Рис.3

Guest Book

Welcome to my first web page

Please enter your private information:

Bottom of Form

Рис.4

Затем я создал однотабличную базу данных и подключил несколько библиотек, необходимых для работы проекта.(См. Рис.5 и Рис.6)

Следующий этап разработки - написание кода(См.Рис.7) Затем отладка процедур.

Так как у создателей этого набора процедур, по-видимому, была несколько другая Гостевая книга, то мне пришлось внести некоторые изменения в код процедур: поменять адрес файла, с которого считываются данные, изменить имя первой строки этого файла и отменить несколько команд – “пропустить строку”(См. Рис.7 - 11).

Как показано на рисунке 8 программа не работала, т.к. не находил необходимый файл. При этом появляется диалоговое окно с указанием номера ошибки и её описанием (См.Рис.9)

Рис.5

Рис.6

Рис.7

Рис.8

Рис.9

Рис.10

Рис.11

X_FirstName:

Sasha

X_LastName:

Sergheev

X_Organization:

College

X_WorkAddress:

A Russso 1

X_Address2:

A Russo 1

X_City:

Chishinev

X_State:

Moldova

X_ZipCode:

22222222

X_Country:

Moldova

X_Email:

sergheev@mail.md

Рис.12

Тексты программ в виде текстового файла и описание их подключения к системе MSOffice

'Объявите переменные глобально, так чтобы они были доступны больше чем одной ‘процедуре;

' Txtobj1 и объекты fs требуют ссылки на библиотеку Microsoft Scripting RunTime

Dim txtobj1 As Scripting.TextStream

Dim strTemp As String

Dim rst1 As ADODB.Recordset

Sub LookForNameStart()

Dim fs As Scripting.FileSystemObject

' Формируйте ссылку к системе файла, и используйте это, чтобы 'открыть текстовый ‘объект, основанный

' на локальном файле, который содержит регистр Гостевой книги

Set fs = New Scripting.FileSystemObject

Set txtobj1 = fs.OpenTextFile (“ F:\formrslt.htm", ForReading)

' Откройте recordset на tblContacts таблице

Set rst1 = New ADODB.Recordset

rst1.Open "tblContacts", CurrentProject.Connection, adOpenKeyset,_ adLockOptimistic

' Пройти цикл через текстовый объект для нахождения линии как раз ‘перед ‘FirstName полем

Do Until txtobj1.AtEndOfStream

strTemp = txtobj1.ReadLine

If InStr(1, strTemp, "X_FirstName") <> 0 Then

ProcessContact

End If

Loop

‘Очистить ресурсы

rst1.Close

Set rst1 = Nothing

txtobj1.Close

Set txtobj1 = Nothing

Set fs = Nothing

End Sub

Sub ProcessContact()

On Error GoTo MyErrorTrap

Dim strFname As String

Dim strLname As String

Dim strCname As String

Dim strSt1 As String

Dim strSt2 As String

Dim strCity As String

Dim strRegion As String

Dim strPostalCode As String

Dim strCountry As String

Dim strEmailAddr As String

Dim intFirst As Integer

Dim intLen As Integer

Dim cmd1 As ADODB.Command

’Извлечь First Name в нужном регистре

strTemp = txtobj1.ReadLine

If InStr(1, strTemp, " ") = 0 Then

intFirst = InStr(1, strTemp, ">") + 1

intLen = InStr(InStr(1, strTemp, ">"), strTemp, "<") - intFirst

strFname = UCase(Mid(strTemp, intFirst, 1)) &_

LCase(Mid(strTemp, intFirst + 1, intLen - 1))

Else

strFname = ""

End If

’Извлечь Last Name в нужном регистре

txtobj1.SkipLine

strTemp = txtobj1.ReadLine

If InStr(1, strTemp, " ") = 0 Then

intFirst = InStr(1, strTemp, ">") + 1

intLen = InStr(InStr(1, strTemp, ">"), strTemp, "<") - intFirst

strLname = UCase(Mid(strTemp, intFirst, 1)) & _

LCase(Mid(strTemp, intFirst + 1, intLen - 1))

Else

strLname = ""

End If

’Извлечь Organization Name в любом регистре

txtobj1.SkipLine

’txtobj1.SkipLine

’txtobj1.SkipLine

strTemp = txtobj1.ReadLine

If InStr(1, strTemp, " ") = 0 Then

intFirst = InStr(1, strTemp, ">") + 1

intLen = InStr(InStr(1, strTemp, ">"), strTemp, "<") - intFirst

strCname = CleanText(Mid(strTemp, intFirst, intLen))

Else

strCname = ""

End If

’Извлечь строки с первым и вторым адресами

txtobj1.SkipLine

strTemp = txtobj1.ReadLine

If InStr(1, strTemp, " ") = 0 Then

intFirst = InStr(1, strTemp, ">") + 1

intLen = InStr(InStr(1, strTemp, ">"), strTemp, "<") - intFirst

strSt1 = CleanText(Mid(strTemp, intFirst, intLen))

Else

strSt1 = ""

End If

txtobj1.SkipLine

strTemp = txtobj1.ReadLine

If InStr(1, strTemp, " ") = 0 Then

intFirst = InStr(1, strTemp, ">") + 1

intLen = InStr(InStr(1, strTemp, ">"), strTemp, "<") - intFirst

strSt2 = CleanText(Mid(strTemp, intFirst, intLen))

Else

strSt2 = ""

End If

’Извлечь City, Region, Postal Code, and Country

txtobj1.SkipLine

strTemp = txtobj1.ReadLine

intFirst = InStr(1, strTemp, ">") + 1

intLen = InStr(InStr(1, strTemp, ">"), strTemp, "<") - intFirst

strCity = Mid(strTemp, intFirst, intLen)

If strCity = " " Then strCity = ""

txtobj1.SkipLine

strTemp = txtobj1.ReadLine

intFirst = InStr(1, strTemp, ">") + 1

intLen = InStr(InStr(1, strTemp, ">"), strTemp, "<") - intFirst

strRegion = Left(Mid(strTemp, intFirst, intLen), 20)

If strRegion = " " Then strRegion = ""

txtobj1.SkipLine

strTemp = txtobj1.ReadLine

intFirst = InStr(1, strTemp, ">") + 1

intLen = InStr(InStr(1, strTemp, ">"), strTemp, "<") - intFirst

strPostalCode = Mid(strTemp, intFirst, intLen)

If strPostalCode = " " Then strPostalCode = ""

txtobj1.SkipLine

strTemp = txtobj1.ReadLine

intFirst = InStr(1, strTemp, ">") + 1

intLen = InStr(InStr(1, strTemp, ">"), strTemp, "<") - intFirst

strCountry = Mid(strTemp, intFirst, intLen)

If strCountry = " " Then strCountry = ""

’Извлечь Email address ; Использовать как строкe в VBA proc, но это добавляется к ‘таблице как гиперсвязь

txtobj1.SkipLine

txtobj1.SkipLine

txtobj1.SkipLine

strTemp = txtobj1.ReadLine

intFirst = InStr(1, strTemp, ">") + 1

intLen = InStr(InStr(1, strTemp, ">"), strTemp, "<") - intFirst

strEmailAddr = Mid(strTemp, intFirst, intLen)

If strEmailAddr = " " Then strEmailAddr = ""

' Используйте этот набор печати для отладки целей

'Debug.Print

'Debug.Print strFname & " " & strLname

'Debug.Print strCname

'Debug.Print strSt1

'Debug.Print strSt2

'Debug.Print strCity & ", "; strRegion & " " & strPostalCode

'Debug.Print strCountry

'Debug.Print strEmailAddr

' Добавьте запись, если это имеет допустимый первичный ключ- клавишу

If strFname <> _

"" And strLname <> "" And strEmailAddr <> "" Then

With rst1

.AddNew

If strFname <> _

"" Then .Fields("FirstName") = strFname

If strLname <> "" Then .Fields("LastName") = strLname

If strCname <> "" Then .Fields("CompanyName") = strCname

If strSt1 <> "" Then .Fields("Address") = strSt1

If strSt2 <> "" Then .Fields("Address1") = strSt2

If strCity <> "" Then .Fields("City") = strCity

If strRegion <> "" Then .Fields("StateOrProvince") = strRegion

If strPostalCode <> "" Then .Fields("PostalCode") = strPostalCode

If strCountry <> "" Then .Fields("Country") = strCountry

If strEmailAddr <> "" Then .Fields("EMailName") = strEmailAddr

.Update

End With

End If

MyExit:

Exit Sub

MyErrorTrap:

If Err.Number = -2147217887 Then

'Перехватчик дублирует ключевую ошибку и заменяет запись

Set cmd1 = New ADODB.Command

With cmd1

.ActiveConnection = CurrentProject.Connection

.CommandText = "DELETE * " & "FROM tblContacts " & _

"WHERE tblContacts.EMailName " & "= '" & strEmailAddr & "'"

.CommandType = adCmdText

.Execute

End With

Resume

Else

Debug.Print Err.Number; Err.Description

Resume MyExit

End If

End Sub

Function CleanText(strText As String)

' Замените специальные символы HTML типа & with & и " with "

CleanText = Replace(strText, "&", "&")

CleanText = Replace(CleanText, """, """")

End Function

Как описывалось выше этот набор процедур используется в приложении Access, для считывания данных с файла с расширением html. В этом файле хранятся данные о пользователях Гостевой книги.