2 Курс Информатика VBA(ЗО) / Книги / В.Д.Хорев - Самоучитель программирования на VBA в Microsoft Office
.pdf
Создание приложения Registrator 243
Написание программного кода
Инициализация и деинициализация
Прежде всего, создадим программный код процедур инициализации и деинициализации. Для этого поместите в процедуры Initialization и Deinitialization операторы, приведенные в листинге 9.8.
ЛИСТИНГ 9.8
Sub Initialization()
Set objOutlook = New Outlook.Application
Set CurNameSpace = objOutlook.GetNamespace("MAPI")
Set FolderList = CurNameSpace.Folders
Application.StatusBar = ""
MaxAttachmentsLen = 0
End Sub
Sub Deinitialization()
objOutlook.Quit
Set objOutlook = Nothing
End Sub
В процедуре Initialization создается новый объект objOutlook класса Outlook.Application. Понятно, что это ключевой объект рассматриваемого здесь приложения, играющий роль сервера автоматизации. Затем в переменную CurNameSpace помещается
ссылка на пространство имен MAPI сервера автоматизации. Это обеспечивает доступ ко всем папкам и элементам инициализированного экземпляра сервера автоматизации. В третьей строке процедуры содержится оператор инициализации переменной FolderList, которая представляет собой ссылка на объект Folders текущего пространства имен. Данный объект есть ни что иное, как перечень папок верхнего уровня, соответствующих учетным записям пользователей на почтовом сервере.
Смысл следующего оператора понятен — он очищает строку состояния. Наконец, последний оператор явно обнуляет значение вспомогательной глобальной переменной, которая будет использована при обработке сообщений с вложениями.
Назначение процедуры Deinitialization, как уже было установлено, прямо противопо-
ложно назначению первой процедуры. В процедуре Deinitialization завершается работа сервера автоматизации с очисткой соответствующей объектной переменной.
Остальные объектные переменные, инициализированные в начале программы, в явной форме очищать не обязательно, так как они очищаются автоматически при очистке объекта-владельца.
Выполните “прогон программы”, чтобы убедиться в том, что все работает нормально. В это раз он должен происходить несколько медленнее, чем вначале (это хорошо видно по строке состояния, которая в течение какого-то времени остается пустой). Это и понятно — приложение Outlook 2000 довольно объемное. Сохраните проект, и будем двигаться дальше.
Синхронизация
Для того чтобы получить информацию от сервера автоматизации, роль которого играет Outlook 2000, необходимо хотя бы один раз синхронизировать локальные папки последнего с папками IMAP, хранящимися на почтовом сервере. Таким образом, нужно создать процедуру синхронизации.
Однако сначала придется создать вспомогательный класс mySync, который обеспечит, вопервых, визуализацию процесса синхронизации, а во-вторых (что более важно) — остановку приложения до тех пор, пока не будут синхронизированы все элементы текущего объекта синхронизации. Действительно, одни папки могут содержать лишь несколько сообщений, и для их синхронизации достаточно будет долей секунды, тогда как на синхронизацию других, содержащих де-
244 Глава 9. Программирование в Outlook: документооборот и электронная почта
сятки и сотни сообщений, может уйти несколько минут. Так как процессы обращения к почтовому серверу и работы приложения VBA выполняются на разных, не связанных друг с другом уровнях, возникает задача обеспечения приостановки работы приложения до завершения синхронизации.
Решить эту проблему можно с помощью классов mySync и Form1. Объект класса mySync обеспечивает отображение модальной формы myForm, представляющей собой объект класса Form1, а также запуск и отслеживание синхронизации с выдачей сигнала о ее завершении. Так как форма myForm является модальной, работа приложения будет приостановлена до тех пор, пока данная форма не будет закрыта. Закрытие же формы выполняется обработчиком события класса mySync, выполняющимся после получения сигнала о завершении синхронизации. С помощью такого изящного механизма и обеспечивается взаимодействие двух асинхронных процессов — процесса обновления локальных папок Outlook и процесса выполнения приложения VBA.
Так как класс формы Form1 и модуль класса mySync были созданы на этапе подготовки приложения, осталось лишь написать собственно код класса, а также код, обеспечивающий его использование.
Для того чтобы подготовить код класса mySync, перейдите в соответствующий модуль и добавьте к строке объявления класса операторы, показанные в листинге 9.9.
ЛИСТИНГ 9.9
Public Sub Start()
mySync.Start
myForm.Show
End Sub
Sub Init(AnItem As String)
Set mySync = objOutlook.Session.SyncObjects(AnItem)
End Sub
Private Sub mySync_SyncStart() myForm.Caption = "Подождите..."
End Sub
Private |
Sub |
mySync_Progress(ByVal |
State |
As |
_ |
|
Outlook.OlSyncState, |
ByVal |
Description |
As |
String, |
_ |
|
ByVal Value As Long, ByVal Max As Long) |
|
|
|
|
||
Cap = Str(Value / Max * 100) & "% " myForm.Label1.Caption = "Идет синхронизация: " & Cap
End Sub
Private Sub mySync_SyncEnd() myForm.Hide
End Sub
Назначение операторов понятно и не требует комментариев. Данные процедуры представляют собой обработчики событий SyncStart, SyncEnd и Progress. Первый и второй обработчики выполняются при поступлении событий начала и окончания синхронизации, а последний — периодически по ходу синхронизации. Событие SyncStart необходимо инициировать программно, тогда, как событие SyncEnd может генерироваться системой при окончании синхронизации. Эти свойства класса SyncObject и будут использованы, чтобы создать собственный класс mySync, предназначенный для открытия, обновления и закрытия обработчиками событий формы myForm класса Form1.
Теперь вернемся к модулю main и добавим в процедуру Syncronization код, показанный в листинге 9.10.
ЛИСТИНГ 9.10
Dim Responce As Integer
Создание приложения Registrator 245
Responce = MsgBox("Выполнять синхронизацию?", _ vbYesNo, "Макрос запущен")
If Responce = vbYes Then
For Each Account In objOutlook.Session.SyncObjects Application.StatusBar = "Учетная запись: " & Account CurSync.Init (Account)
CurSync.Start Next Account
End If
Как вы помните, Account — это объект класса SyncObject. В данном фрагменте программного кода выполняется последовательный перебор всех объектов синхронизации, хранящихся в коллекции SyncObjects текущего сеанса сервера автоматизации objOutlook. Ссылка на очередной объект синхронизации передается методу Init объекта CurSync класса mySync. Возвратясь к листингу 9.9, можно увидеть, что данный метод инициализирует экземпляр класса mySync, вследствие чего при вызове метода CurSync.Start управление передается не стандартному обработчику события SyncStart класса SyncObject, а созданному аналогичному
обработчику класса mySync.
Сохраните проект и попробуйте выполнить его с помощью кнопки Провести регистрацию, находящейся на рабочем листе Панель управления. Если все сделано правильно, сначала появится окно сообщения, предлагающее подтвердить необходимость регистрации, а затем, если будет выбран утвердительный ответ, на экране появится окно, показанное на рис. 9.15.
Рис. 9.15. На созданной форме отображаются сведения о ходе процесса синхронизации, а в строке состояния — сведения о текущей учетной записи
246 Глава 9. Программирование в Outlook: документооборот и электронная почта
Казалось бы, на этом можно было бы остановиться, считая, что задача синхронизации решена. Однако в действительности это может оказаться не совсем так. Дело в том, что в некоторых случаях указанным выше методом можно синхронизовать только папку входящих сообщений, а другие папки Outlook почему-то игнорирует. Для того чтобы заставить “капризное дитя Microsoft” работать, как положено, можно применить следующий прием (листинг 9.11, изменения процедуры синхронизации выделены полужирным шрифтом).
ЛИСТИНГ 9.11
Dim Responce As Integer
Responce = MsgBox("Выполнять синхронизацию?", _ vbYesNo, "Макрос запущен")
If Responce = vbYes Then
For Each Account In objOutlook.Session.SyncObjects Application.StatusBar = "Учетная запись: " & Account
Set CurExplorer = _ FolderList(Account.Name).Folders(sSentItems).GetExplorer
CurExplorer.Display
Application.Wait (Now + TimeValue("0:00:05")) CurExplorer.Close
Set CurExplorer = Nothing
CurSync.Init (Account) CurSync.Start
Next Account End If
Теперь после получения ссылки на очередную синхронизируемую учетную запись имя этой учетной записи, а также название нужной папки (в данном случае — папки исходящих сообщений, см. листинг 9.3) используется для вызова метода GetExplorer коллекции Folders объекта FolderList. Этот метод возвращает ссылку на иксплорер, с помощью которого можно просмотреть содержимое заданной папки указанной учетной записи. Фокус заключается в том, что если задержать выполнение приложения на несколько секунд, включится внутренний механизм Outlook 2000, и папка будет синхронизирована автоматически, что легко увидеть, открыв окно иксплорера.
Именно эту задачу и выполняют добавленные операторы — сначала будет получена ссылка на нужный иксплорер, затем он будет отображен для наглядности, после чего приостанавлено выполнение приложения на 5 с, а затем закрыт иксплорер и очищана соответствующая переменная. Два последних оператора важны, — если имеется активный иксплорер, то при начале синхронизации с помощью объекта CurSync начнется параллельная синхронизация учетной записи иксплорером, что может привести к неустойчивой работе и зависанию приложения.
Сохраните проект и снова проверьте, как он работает. Теперь на экране поочередно должны появлятся то диалоговое окно синхронизации, то окно Outlook 2000 (т.е. окно текущего иксплорера, показывающего содержимое папки исходящих сообщений очередной учетной записи). Если в папках исходящих сообщений были несинхронизированные записи, они появятся в области просмотра содержимого папки в правой части окна иксплорера.
Теперь можно считать, что с синхронизацией порядок наведен. В принципе, если вас устраивает полученный набор почтовых сообщений, в дальнейшем можете просто отвечать отрицательно на вопрос приложения, нужно ли выполнять синхронизацию, — это позволит сэкономить время на тестовых “прогонах программы”.
Создание приложения Registrator 247
Определение нужного интервала и создание нового листа
Приведенные в этом разделе две процедуры носят вспомогательный характер, поэтому объединены в одном разделе. Их код можно реализовать по-разному, например, так, как показано в листингах 9.12 и 9.13.
ЛИСТИНГ 9.12
Function CalculateInterval(sStartDate, sEndDate As Variant) As Variant
Dim sNow, sNowTime As String
Dim DefaultDateValue, DefaultDateStart, DefaultDateEnd As Variant CalculateInterval = 0
sNow = Now: sNowTime = PadTime(Now)
If sNowTime < sEveningMail Then
'*** Время получения вечерней почты еще не настало --
'*** получаем почту за предыдущую ночь (или выходные).
If Weekday(sNow) = vbMonday Then
DefaultDateValue = DateValue(DateAdd("y", -3, sNow))
Else
DefaultDateValue = DateValue(DateAdd("y", -1, sNow))
End If
DefaultDateStart = DefaultDateValue & " " & sEveningMail
DefaultDateEnd = DateValue(sNow) & " " & sMorningMail
Else
'*** Время получения вечерней почты уже настало --
'*** получаем почту за сегодняшний день
DefaultDateStart = DateValue(sNow) & " " & sMorningMail
DefaultDateEnd = DateValue(sNow) & " " & sEveningMail
End If
sStartDate = GetDate("НАЧАЛА", DefaultDateStart)
sEndDate = GetDate("ОКОНЧАНИЯ", DefaultDateEnd)
CalculateInterval = DateDiff("s", sStartDate, sEndDate)
End Function
Function PadTime(TheDate As Variant) As String
Dim sTime As String
sTime = TimeValue(TheDate)
If Len(sTime) < 8 Then sTime = "0" & sTime
PadTime = sTime
End Function
Function GetDate(Prompt As String, Default As Variant) As Variant
Dim TheDate As String
Do
TheDate = InputBox("Дата и время " & Prompt & _
" периода, за который необходимо получить почту", _
"Определение периода получения почты", Default)
If Not IsDate(TheDate) Then MsgBox "Дата " & TheDate & _
" указана неверно!", vbCritical
Loop While Not IsDate(TheDate)
GetDate = TheDate
End Function
ЛИСТИНГ 9.13
Sub MakeNewReport(sStartDate As Variant, sEndDate As Variant)
248 Глава 9. Программирование в Outlook: документооборот и электронная почта
Dim SheetName As Variant
Dim Found As Boolean
Dim NewSheet, ControlPanel As Worksheet
Set ControlPanel = Sheets.Item("Панель управления") Found = False
SheetName = Left(DateValue(sStartDate), 6) & _ Right(DateValue(sStartDate), 2) & _ sSpace & _
Left(PadTime(TimeValue(sStartDate)), 2) & _ sDot & _
Mid(PadTime(TimeValue(sStartDate)), 4, 2) & _ sHiphen & _
Left(DateValue(sEndDate), 6) & _
Right(DateValue(sEndDate), 2) & _ sSpace & _
Left(PadTime(TimeValue(sEndDate)), 2) & _ sDot & _ Mid(PadTime(TimeValue(sEndDate)), 4, 2)
For i = 1 To Sheets.Count
If Sheets.Item(i).Name = SheetName Then
MsgBox "Лист записей за период с " & sStartDate & _
" по " & sEndDate & " уже существует."
Set NewSheet = Sheets.Item(i)
Found = True
Exit For
End If
Next i
If Not Found Then
Set NewSheet = Sheets.Add
NewSheet.Name = SheetName
NewSheet.Move After:=ControlPanel
End If
NewSheet.Select: GoNext (sStart)
End Sub
Как легко заметить, в листинге 9.12 приведена не только функция CalculateInterval, возвращающая значение интервала между двумя заданными датами, выраженное в секундах, а также изменяющая значения глобальных переменных DateStart и DateEnd (см. листинг 9.2),
— в нем также содержатся вспомогательные функции PadTime и GetDate. Первая из них предназначена для дополнения слева строкового представления времени символом незначащего нуля, а вторая — для организации диалога с пользователем и запроса у него ввода даты с проверкой корректности введенного значения. Две последние функции просты, а их работу легко понять из анализа их исходного текста.
Функция же CalculateInterval имеет две “изюминки”. Во-первых, она помогает пользователю, формируя для него дату и время начала (окончания) интервала, устанавливаемые в окне запроса по умолчанию. Так, если пользователь выполняет регистрацию утром в понедельник, функция автоматически предложит ему провести регистрацию всех писем, поступивших за выходные, а также во второй половине дня в пятницу. Если же он запустит регистрацию в понедельник вечером, функция предложит провести регистрацию только писем, поступивших за текущий
Создание приложения Registrator 249
день. При этом пользователь может отказаться от предложенных ему по умолчанию значений даты и (или) времени, и ввести другие значения — например, указать, чтобы программа выполнила регистрацию всех писем за прошлый месяц.
Во-вторых, интервал вычисляется как разность между двумя датами, выраженная в секундах. Это вычисление производится простой полезной функцией DateDiff, которая будет рассмотрена несколько позже.
Что касается функции MakeNewReport (листинг 9.13), то она также проста и не требует особых комментариев. Создаваемый в ней новый лист отчета помещается сразу за листом Панель управления и получает имя, соответствующее заданному диапазону, например 01.01.01 14.00–
02.01.01 09.00.
Единственным нюансом этой функции является наличие в ней вызова процедуры GoNext (в конце листинга, выделена полужирным шрифтом). Это не стандартная процедура VBA, а вспомогательная. Она предназначена для управления выделенной ячейкой. Текст этой процедуры приведен ниже в листинге 9.14.
ЛИСТИНГ 9.14
Sub GoNext(sSelector As String)
Dim Temp, Address, FirstPart, SecondPart, Scnd, Frst As String Dim SecondPartLen, FirstPartLen As Integer
Address = ActiveCell.Address
Temp = Right(Address, Len(Address) - 1)
SecondPartLen = Len(Address) - InStr(Temp, "$")
FirstPartLen = Len(Address) - SecondPartLen
FirstPart = Left(Address, FirstPartLen)
SecondPart = Right(Address, SecondPartLen)
Scnd = "$" & LTrim(Str(Val( _
Right(SecondPart, SecondPartLen - 1)) + 1))
If Right(FirstPart, 1) < "Z" Then
Frst = Left(FirstPart, FirstPartLen - 1) & _
Chr(Asc(Right(FirstPart, 1)) + 1)
Else
If FirstPartLen = 2 Then
Frst = "$AA"
Else
Frst = "$" & Chr(Asc(Mid(FirstPart, 2, 1)) + 1) & "A"
End If
End If
Select Case sSelector
Case sRow
Range(FirstPart & Scnd).Select
Case sCol
Range(Frst & SecondPart).Select
Case sHome
Range("$A" & SecondPart).Select
Case sStart
Range("$A$1").Select
End Select
End Sub
Несмотря на довольно сложные вычисления, назначение процедуры простое — в зависимости от поступившего на вход селектора переместить маркер текущей ячейки на одну строку вниз (sRow), на один столбец вправо (sCol), в начало текущей строки (sHome) или в левую верхнюю ячейку рабочего листа (sStart). Определение возможных значений селектора приведено в листинге
250 Глава 9. Программирование в Outlook: документооборот и электронная почта
9.3. Эта процедура будет часто использоваться в других процедурах и функциях приложения при генерации отчета о зарегистрированных сообщениях.
Поместите все фрагменты кода, приведенные в листингах 9.12–9.14 в модуль misc, сохраните проект и выполните тестовый “прогон приложения”. Для ускорения работы приложения на вопрос, нужно ли выполнять синхронизацию, можно ответить отрицательно. Если программный код был набран правильно, во время работы приложения на экране дважды появится диалоговое окно, предлагающее первый раз ввести дату начала, а второй — окончания периода, за который необходимо зарегистрировать почту, подобное тому, которое приведено на рис. 9.16.
После ввода даты будет создан новый лист, имя которого должно состоять из дат и времени начала и окончания указанного периода. Убедившись, что приложение отработало правильно (в строке состояния появилось сообщение “Макрос выполнен успешно”), удалите только что созданный лист и перейдем к следующему этапу.
Рис. 9.16. Это окно будет “терзать” пользователя до тех пор, пока он не введет корректную дату
Ключевая процедура приложения — выборка входящих и исходящих писем
Теперь у нас есть все необходимое для разработки основной процедуры приложения, которая выполняет выборку входящих и исходящих писем и выводит найденную информацию на созданный для этой цели рабочий лист.
Согласно листингу 9.5, эта процедура называется ProcessFolder. Как показано в листинге, она вызывается в главной программе два раза — на этапах 6 и 9. При первом вызове в качестве параметра ей передается стандартное название папки, которое используется всеми учетными записями для папки входящих сообщений, а при втором — стандартное название папки исходящих сообщений. Эти названия хранятся в константах sInbox и sSentItems, соответственно (см. лис-
тинг 9.3).
Итак, откройте модуль main, найдите в нем заготовку процедуры ProcessFolder и поместите между операторами Sub и End Sub это йпроцедуры программный код согласно листингу
9.15.
ЛИСТИНГ 9.15
Sub ProcessFolder(FolderType As String)
For Each Account In objOutlook.Session.SyncObjects
Set CurFolder = FolderList(Account.Name).Folders(FolderType)
Application.StatusBar = "Учетная запись " & Account & _ ", папка " & CurFolder
Создание приложения Registrator 251
For Each FolderItem In CurFolder.Items
If FolderItem.MessageClass = "IPM.Note" Then
Set CurMsg = FolderItem
With CurMsg
Selector = DateDiff("s", .ReceivedTime, DateEnd) If (Selector > 0) And (Selector < Interval) Then
If FolderType = sInbox Then ActiveCell = .SenderName
If .SentOnBehalfOfName <> .SenderName Then ActiveCell = ActiveCell & " (" & _
.SentOnBehalfOfName & ")"
End If Else
ActiveCell = .To
If .CC <> "" Then ActiveCell = ActiveCell & _ ", копия: " & .CC
If .BCC <> "" Then ActiveCell = ActiveCell & _ ", скрытая копия: " & .BCC
End If
ActiveCell.Font.Size = 10 - Len(ActiveCell) \ _ iGoodAttachWidth
ActiveCell.WrapText = True
If Len(ActiveCell) > 50 Then _ ActiveCell.VerticalAlignment = xlTop
GoNext (sCol)
ActiveCell = .Size: GoNext (sCol) If .Attachments.Count > 0 Then
For Each Attach In .Attachments
ActiveCell = ActiveCell & Attach.Filename & " " Next Attach
ActiveCell = Left(ActiveCell, Len(ActiveCell) - 1) ActiveCell.WrapText = True
ActiveCell.Font.Size = "6"
Else
ActiveCell = "нет" End If
If Len(ActiveCell) > MaxAttachmentsLen Then
MaxAttachmentsLen = Len(ActiveCell) End If
GoNext (sCol)
ActiveCell = .ReceivedTime ActiveCell.NumberFormat = "dd/mm/yyyy hh:mm" GoNext (sCol)
ActiveCell = .Subject: GoNext (sCol) ActiveCell = Account.Name: GoNext (sRow) GoNext (sHome)
End If
End With '*** CurMsg End If
Next FolderItem Next Account
If FolderType = sInbox Then
GoNext (sHome): GoNext (sRow)
252 Глава 9. Программирование в Outlook: документооборот и электронная почта
End If
End Sub
Данная процедура решает основную задачу приложения — выбирает из локальных папок Outlook 2000 сведения о сообщениях, отправленных и полученных в течении заданного периода, и выводит эти сведения в виде таблицы Excel. Сама по себе процедура довольно проста, поэтому не будем детально ее разбирать, а ограничимся лишь кратким перечислением некоторых ее особенностей, которые, как говорится, “не лежат на поверхности”.
•В основном цикле процедуры используется уже известный метод перебора учетных записей, основанный на последовательном получении ссылок на объекты коллекции SyncObjects текущего сеанса сервера автоматизации objOutlook. С помощью полученной ссылки на очередной объект синхронизации, представляющей собой ничто иное как учетную запись соответствующего пользователя, а также типа синхронизируемых при данном прогоне процедуры папок (задается в качестве параметра при вызове процедуры) инициализируется ссылка на объект CurFolder, представляющий папку Outlook 2000 с заданным названием, которая находится в списке папок заданной учетной записи.
•Далее выполняется вложенный цикл, в котором перебираются все объекты коллекции Items заданной папки. В этом цикле может показаться странным использование промежуточного объекта FolderItem класса Object. Действительно, можно было бы в качестве переменной цикла использовать объект CurMsg, который относится к нужному в данном случае классу MailItem. Однако если попробовать выполнить такую замену, заком-
ментировав строки, как показано на рис. 9.17, а также соответствующий оператор Next в конце процедуры, работа приложения может завершиться аварийно с выдачей сообщения об ошибке (рис. 9.17).
Рис. 9.17. Замена класса переменной цикла может привести к аварийному завершению работы приложения