MyTetra Share
Делитесь знаниями!
Способы интеграции MS ACCESS и MS Outlook Печать E-mail
16.03.2019
23:43
Раздел: !Закладки - VBA - Outlook
Способы интеграции MS ACCESS и MS Outlook Печать E-mail
Автор osmor   
18.09.2006 г.

Данной статьей автор не ставит перед собой задачу рассказать о всех возможных способах взаимодействия MS Access и MS Outlook или сравнить между собой несколько способов.
Задача данной статьи помочь начинающим программистам получить начальную информацию о путях интеграции MS Access и MS Outlook и дать ссылки на справочные материалы.

Вся информация, приведенная в данной статье взята из HELP и с сайта msdn.microsoft.com

1. Связывание таблиц

Самый простой способ это использовать связанные таблицы.

Access позволяет прилинковать таблицы MSOutlook. Достаточно просто вызвать контекстное меню на закладке "Таблицы" и в окне выбора файла в качестве типа файлов указать "Outlook". Далее нужно выбрать какие данные вы ходите прилинковать папку "входящие" , "адресную книгу" или задачи. И вот уже в окне Aсcess появилась связанная таблица с соответствующими данными. Данные в прилинкованных таблицах Outlook доступны только для чтения.

Есть только маленький нюанс, для того что бы это стало возможным, нужно установить Microsoft Office Outlook в качестве почтовой программы по умолчанию.

2. Использование MS Outlook View Control.

MS Outlook View Control представляет собой ActiveX который легко встраивается в вашу программу (не обязательно Access), и предоставляет методы и свойства для работы с Outlook. Это фактически Outlook c миниатюре, внешний вид представления данных ничем не отличается от представления этих данных в Outlook. Минимального программирования достаточно для обеспечения пользователю доступа ко всем основным функциям Outlook.

Как использовать MS Outlook View Control в своей программе можно посмотреть в моем примере : http://hiprog.com/index.php?option=com_content&task=view&id=251661547&Itemid=35

MS Outlook View Control для версий начиная с Outlook2000 доступен для загрузки на сайте MS. И конечно там есть вся необходимая документация по работе с ним. Вот несколько полезных ссылок:
http://support.microsoft.com/kb/281618/
http://www.microsoft.com/downloads/details.aspx?displaylang=en&FamilyID=831F957F-3190-48DA-A099-2BDBC7397623
http://support.microsoft.com/kb/q303835/
http://support.microsoft.com/kb/291407/

3. Использование технологии COM.

Outlook как и другие продукты входящие в состав MSOffice поддерживают технологию COM, т.е. доступ к его объектной модели возможен из других программ. Для работы нужно только одно, знать эту объектную модель.
Информацию о объектах, методах, свойствах и событиях Outlook можно почерпнуть в справочном файле, он обычно расположен в папке с офисом, и называется VBAOLХХ.CHM (где ХХ - версия офиса).
Так же этот файл доступен на сайте MS:
http://www.microsoft.com/downloads/details.aspx?FamilyId=A1CEAD80-23E2-456F-8618-4DA50CC2C38C&displaylang=en

Там же можно найти множество примеров:

Using Automation in Microsoft Office Access 2003 to Work with Microsoft Office Outlook 2003
Using Automation to Send a Microsoft Outlook Message
How to Create a New Contact Item in Outlook with Automation
Using Automation to Add a Task/Reminder to MS Outlook
How to automate Outlook 2002 from another program

Ниже приведены несколько функций демонстрирующих возможности данного способа доступу к данным Outlook:
(Замечание, предполагается что в программе установлена ссылка на MS Outlook)

Function ListOLTasks()
'список задач
Dim OL_App As Outlook.Application
Dim OL_NameSpace As Outlook.NameSpace
Dim OL_FolderTask As Outlook.MAPIFolder
Dim OL_ItemTask As Outlook.TaskItem
Dim RecipientTask As Recipient
' получаем объект Outlook
Set OL_App = CreateObject("Outlook.Application")
'получаем Namespace
Set OL_NameSpace = OL_App.GetNamespace("MAPI")
' получаем ссылку на папку задач
Set OL_FolderTask = OL_NameSpace.GetDefaultFolder(olFolderTasks)
' перебираем все задачи в папке
For Each OL_ItemTask In OL_FolderTask.Items
  With OL_ItemTask
'для задачи выводим тему, описание, дату начала, срок исполнения, дату выполнения и исполнителей
     Debug.Print "Tema: " & .Subject
     Debug.Print "Описание: " & .Body
     Debug.Print "Начало: " & .StartDate
     Debug.Print "Срок: " & .DueDate
     Debug.Print "Выполнена: " & .DateCompleted
     Debug.Print "Исполнители: " & .Owner
'если коллекция получателей не пустая, то выводим список получателей задачи
     If .Recipients.Count > 0 Then
      Debug.Print "Адреса получателей: ";
          For Each RecipientTask In .Recipients
             Debug.Print RecipientTask.Address;
          Next
     End If
   End With
   Debug.Print
   Debug.Print "_______________________________________________"
Next
End Function
Function ListOLInbox()
'спиcок писем в папке "входящие"
Dim OL_App As Outlook.Application
Dim OL_NameSpace As Outlook.NameSpace
Dim OL_FolderMail As Outlook.MAPIFolder
Dim OL_ItemMail As Outlook.MailItem
Dim OL_Attachment As Outlook.Attachment
' получаем объект Outlook
Set OL_App = CreateObject("Outlook.Application")
'получаем Namespace
Set OL_NameSpace = OL_App.GetNamespace("MAPI")
' получаем ссылку на папку Входящие
Set OL_FolderMail = OL_NameSpace.GetDefaultFolder(olFolderInbox)
' перебираем все письма в папке
For Each OL_ItemMail In OL_FolderMail.Items
With OL_ItemMail
'выводим тему, время получения, имя и адрес отправителя и текст письма
  Debug.Print .BodyFormat
  Debug.Print "Tema: " & .Subject
  Debug.Print "Получено: " & .ReceivedTime
  Debug.Print "Имя и адрес отправителя: " & .SenderName & " (" & .SenderEmailAddress & ")"
  Debug.Print "Текст письма: " & .Body
'если есть вложения выводим название вложенного файла
  If .Attachments.Count > 0 Then
   Debug.Print "Вложения: "
     For Each OL_Attachment In .Attachments
        Debug.Print OL_Attachment.FileName
     Next
  End If
End With
Debug.Print "_______________________________________________"
Next
End Function

Function ListOLContacts()
'спиcок Контактов
Dim OL_App As Outlook.Application
Dim OL_NameSpace As Outlook.NameSpace
Dim OL_FolderContsct As Outlook.MAPIFolder
Dim OL_ItemContact As Outlook.ContactItem
Dim OL_Attachment As Outlook.AddressEntry
' получаем объект Outlook
Set OL_App = CreateObject("Outlook.Application")
'получаем Namespace
Set OL_NameSpace = OL_App.GetNamespace("MAPI")
'получаем ссылку на папку "Контакты"
Set OL_FolderContsct = OL_NameSpace.GetDefaultFolder(olFolderContacts)
' перебираем все контакты в папке
  For Each OL_ItemContact In OL_FolderContsct.Items
   With OL_ItemContact
'выводим имя, 3 возможных E-mail, домашний и моблиный телефоны
    Debug.Print "Имя: " & .Subject
    Debug.Print "E-mai №1: " & .Email1Address
    Debug.Print "E-mai №2: " & .Email2Address
    Debug.Print "E-mai №3: " & .Email3Address
    Debug.Print "Домашний телефон: " & .HomeTelephoneNumber
    Debug.Print "Мобильный телефон: " & .MobileTelephoneNumber
   End With
   Debug.Print "_______________________________________________"
  Next
End Function
Function ListOLMeeting()
'список встреч назначенных на следующую неделю
Dim OL_App As Outlook.Application
Dim OL_NameSpace As Outlook.NameSpace
Dim OL_FolderCalendar As Outlook.MAPIFolder
Dim OL_CalendarItems As Outlook.Items
Dim OL_MeetingItem As Object
Dim OL_Attendee As Recipient
' получаем объект Outlook
Set OL_App = CreateObject("Outlook.Application")
'получаем Namespace
Set OL_NameSpace = OL_App.GetNamespace("MAPI")
' получаем ссылку на папку календарь
Set OL_FolderCalendar = OL_NameSpace.GetDefaultFolder(olFolderCalendar)
'используя метод Restrict отбираем только те записи
'у которых свойство start > больше сегодняшней даты и меньше чем сегодня плюс 7 дней
' т.е. те которые назначены на след неделю
Set OL_CalendarItems = OL_FolderCalendar.Items.Restrict("[start]> '" & Date & "' And [start] <= '" & Date + 7 & "'")
  For Each OL_MeetingItem In OL_CalendarItems ' перебираем все отобранне записи
   With OL_MeetingItem
' если найденная запись - встреча то выводит информацию о
    If .Class = olAppointment Then
     Debug.Print "Tema: " & .Subject
     Debug.Print "Описание: " & .Body
     Debug.Print "Начало: " & .Start
     Debug.Print "Продолжительность: " & .Duration & " мин."
     Debug.Print "Место встречи: " & .Location
'если коллекция участников получателей не пустая, то выводим список участников
     If .Recipients.Count > 0 Then
      Debug.Print "Приглашены: ",
          For Each OL_Attendee In .Recipients
               Debug.Print OL_Attendee.Name; "; ";
          Next
     End If
    End If
   End With
    Debug.Print
    Debug.Print "_______________________________________________"
   Next
End Function


Function OpenExistOLContacts(strNameContact AsString)
'Открывает существующий контакт в имени которых содержится переданное значение
Dim OL_App As Outlook.Application
Dim OL_NameSpace As Outlook.NameSpace
Dim OL_FolderContsct As Outlook.MAPIFolder
Dim OL_ItemContact As Outlook.ContactItem
Dim OL_Attachment As Outlook.AddressEntry

Set OL_App = CreateObject("Outlook.Application") ' получаем объект Outlook
Set OL_NameSpace = OL_App.GetNamespace("MAPI") 'получаем Namespace
'получаем ссылку на папку "Контакты"
Set OL_FolderContsct = OL_NameSpace.GetDefaultFolder(olFolderContacts)
  For Each OL_ItemContact In OL_FolderContsct.Items ' перебираем все контакты в папке
' если заголовок контакта содержит искомую строку, то открываем его

   If InStr(1, OL_ItemContact.Subject, strNameContact) Then OL_ItemContact.Display
Next
End Function


Function OpenExistOLTasks()
'Открывает все не закрытые задачи
Dim OL_App As Outlook.Application
Dim OL_NameSpace As Outlook.NameSpace
Dim OL_FolderTask As Outlook.MAPIFolder
Dim OL_ItemTask As Outlook.TaskItem
Dim RecipientTask As Recipient

Set OL_App = CreateObject("Outlook.Application") ' получаем объект Outlook
Set OL_NameSpace = OL_App.GetNamespace("MAPI") 'получаем Namespace
' получаем ссылку на папку задач
Set OL_FolderTask = OL_NameSpace.GetDefaultFolder(olFolderTasks)
  For Each OL_ItemTask In OL_FolderTask.Items ' перебираем все задачи в папке
    If OL_ItemTask.Status <> olTaskComplete Then OL_ItemTask.Display
  Next
End Function
Function CreateNewTask()
'создает новую задачу повторяющуюся каждые 3 недели
'и назначенает ее другому ответсветнному
Dim OL_App As Outlook.Application
Dim OL_ItemTask As Outlook.TaskItem
Dim RecipientTask As Recipient
Dim OL_Pattern As Outlook.RecurrencePattern

Set OL_App = CreateObject("Outlook.Application") ' получаем объект Outlook
Set OL_ItemTask = OL_App.CreateItem(OLTaskItem) ' создаем новую задачу
Set OL_Pattern = OL_ItemTask.GetRecurrencePattern ' получаем ссылку на объект
'RecurrencePattern содержащий информацию о периодичности задачи или встречи
With OL_Pattern
' устанавливаем частоту повторений (еженедельно)
  .RecurrenceType = olRecursWeekly
' интервал повторений (раз в 2 недели)
  .Interval = 2
' создавать новую задача с указанной частотой после завершения предудущей
    .Regenerate = True
End With
With OL_ItemTask
  .Subject = "Tema задачи"
  .Body = "Описание задачи"
  .StartDate = Date ' дата начала выполнения задачи
  .DueDate = DateAdd("y", 5, Date) ' дата окончания
  .Assign ' назначим эту задачу некому Иванову
   Set RecipientTask = OL_ItemTask.Recipients.Add("Иванов Иван")
  .Save ' сохраним задачу
  .Display (True) 'покажем задачу в модальном окне
End With
End Function
Function CreateNewMemo()
'создает новое письмо с вложением для нескольких адресатов
Dim OL_App As Outlook.Application
Dim OL_ItemMail As Outlook.MailItem
Dim RecipientTask As Recipient
Dim OL_Pattern As Outlook.RecurrencePattern

Set OL_App = CreateObject("Outlook.Application") ' получаем объект Outlook
Set OL_ItemMail = OL_App.CreateItem(olMailItem) ' создаем новое письмо
With OL_ItemMail
  .To = " osmor@mail.ru" 'адрес получателя
  .CC = " osmor@mail.ru" 'копия
   .BodyFormat = olFormatHTML 'формат письма
   .Subject = "Отчет по продажам за " & CStr(Date) ' заголовок письма
' текст письма. Для красоты HTML
   .HTMLBody = "<body><div align='center'> <table width='50%' border='1'>" & _
   "<caption align='top'> Продажи по салонам за " & CStr(Date) & "</caption>" & _
   "<tr><th cope='col' width='60%'>Салон <th width='40%'>Cумма" & _
   "<tr><td>Алексеевская <td align='right'>25 021 <tr><td>Маросейка<td align='right'>28 452" & _
   "<tr><td>Охотный ряд <td align='right'>22 245<tr></table></div></body>"
'вложение. Если файл не существует, то будет ошибка
   .Attachments.Add "c:/Forum_ex.INF"
   .Attachments.Add "c:/FORUM_EX.MDX"
   .OriginatorDeliveryReportRequested = True 'Уведомление о доставке
   .ReadReceiptRequested = True 'Уведомление о прочтении
   .Save ' сохраним письмо
   .Send ' отправим письмо
End With
End Function
Function CreateNewMeeting()
'создает новую встречу
Dim OL_App As Outlook.Application
Dim OL_ItemMeeting As Outlook.AppointmentItem
Dim OL_Attendee As Outlook.Recipient
' получаем объект Outlook
Set OL_App = CreateObject("Outlook.Application")
' создаем новую встречу
Set OL_ItemMeeting = OL_App.CreateItem(olAppointmentItem)
With OL_ItemMeeting
  .Subject = "Предлагаю попить пива"
  .Body = "Возникла острая необходимость встретиться."
  .MeetingStatus = olMeeting 'статус свстречи
' назначим встречу на завтра в 18:00
  .Start = Date + 1 + CDate("18:00")
  .Duration = 120 'продолжительность 2 часа
'установим напоминание за 1 час до начала встречи
  .ReminderSet = True
  .ReminderMinutesBeforeStart = 60
'добавим участников встречи
  Set OL_Attendee = .Recipients.Add("Bill Gates")
   OL_Attendee.Type = olRequired 'обязательынй участник>
  Set OL_Attendee = .Recipients.Add("George W. Bush")
  OL_Attendee.Type = olOptional 'не обязательынй участник
'место встречи
  .Location = "На углу у Патриарших"
  .Save ' сохраним встречу
  .Display (True) 'покажем задачу в модальном окне
End With
End Function
Function ViewOLTasks()
'Выводит список View доступных для папки задачи и
'открывает список задач c применением случайного доступного вида
Dim OL_App As Outlook.Application
Dim OL_NameSpace As Outlook.NameSpace
Dim OL_FolderTask As Outlook.MAPIFolder
Dim OL_View As View
Dim I AsInteger
' получаем объект Outlook
Set OL_App = CreateObject("Outlook.Application")
'получаем Namespace
Set OL_NameSpace = OL_App.GetNamespace("MAPI")
' получаем ссылку на папку задач
Set OL_FolderTask = OL_NameSpace.GetDefaultFolder(olFolderTasks)
With OL_FolderTask
' перебираем все доступные для папки виды (Views)
  Debug.Print "Доступные виды:"
  For Each OL_View In .Views
     Debug.Print OL_View.Name
   Next
' поучаем случаное число
   Randomize
   I = Int(.Views.Count * Rnd()) + 1
   OL_FolderTask.Views(I).Apply 'применяем выбранный вид
   .Display 'открываем окно в папкой "Задачи"
End With
'для примера получим значение CurrenView через объект Explorer
Debug.Print "Установлен вид - " & OL_App.ActiveExplorer.CurrentView

End Function
Function ViewOLCalendar()
'Открывает паку каледарь
Dim OL_App As Outlook.Application
Dim OL_NameSpace As Outlook.NameSpace
Dim OL_FolderCalendar As Outlook.MAPIFolder
' получаем объект Outlook
Set OL_App = CreateObject("Outlook.Application")
'получаем Namespace
Set OL_NameSpace = OL_App.GetNamespace("MAPI")
' получаем ссылку на папку Календарь
Set OL_FolderCalendar = OL_NameSpace.GetDefaultFolder(olFolderCalendar)
OL_FolderCalendar.Display 'открываем окно в папкой "Календарь"

End Function

Function Send_Receive()
'Принудительная отправка/прием почты
Dim OL_App As Outlook.Application
Dim OL_NameSpace As Outlook.NameSpace
Dim OL_FolderCalendar As Outlook.MAPIFolder
' получаем объект Outlook
Set OL_App = CreateObject("Outlook.Application")
'получаем Namespace
Set OL_NameSpace = OL_App.GetNamespace("MAPI")
 Dim oSyncs As Outlook.SyncObjects
 Dim oSync As Outlook.SyncObject

   Set oSyncs = OL_NameSpace.SyncObjects
   Set oSync = oSyncs.Item("Все учетные записи") 
'если английский Outlook то "All Accounts"

   oSync.Start
End Function




Не берусь судить какой из перечисленных выше способов лучше... все зависит от поставленной задачи.

Так же в этом разделе:
 
MyTetra Share v.0.52
Яндекс индекс цитирования