Цикл по получателям в назначениях Outlook - PullRequest
Новая
       13

Цикл по получателям в назначениях Outlook

0 голосов
/ 28 марта 2019

Я использую этот код и пытаюсь получить доступ к Получателям (адрес электронной почты, а также отображаемое имя) каждой встречи Outlook, но получаю сообщение об ошибке:

Ошибка времени выполнения '287' Ошибка приложения или объекта

Эта ошибка выделена в строке: Для каждого получателя в olApt.recipients 

Sub ListAppointments()
Dim olApp As Object
Dim olNS As Object
Dim olFolder As Object
Dim olApt As Object
Dim NextRow As Long
Dim FromDate As Date
Dim ToDate As Date

FromDate = CDate("01/04/2019")
ToDate = CDate("14/04/2019")

On Error Resume Next
Set olApp = GetObject(, "Outlook.Application")
If Err.Number > 0 Then Set olApp = CreateObject("Outlook.Application")
On Error GoTo 0

Set olNS = olApp.GetNamespace("MAPI")
Set olFolder = olNS.GetDefaultFolder(9) 'olFolderCalendar
NextRow = 2

With Sheets("Sheet1") 'Change the name of the sheet here
    .Range("A1:D1").Value = Array("Meeting", "Date", "Location", "Invitees")
    For Each olApt In olFolder.Items
        If (olApt.Start >= FromDate And olApt.Start <= ToDate) Then
            .Cells(NextRow, "A").Value = olApt.Subject
            .Cells(NextRow, "B").Value = CDate(olApt.Start)
            .Cells(NextRow, "C").Value = olApt.Location
            .Cells(NextRow, "D").Value = olApt.Categories

            Dim recip As Object
            Dim allRecip As String
            For Each recip In olApt
                Debug.Print (recip.Address)
                .Cells(NextRow, "E").Value = olApt.Address
            Next

            NextRow = NextRow + 1
        Else
        End If
    Next olApt
    .Columns.AutoFit
End With

Set olApt = Nothing
Set olFolder = Nothing
Set olNS = Nothing
Set olApp = Nothing
End Sub

UPDATE

Я пытался 

For Each recip in olApt.recipients
    .Cells(NextRow, "E").Value = olApt.recipients.Address
Next

И я все еще получаю ошибки ниже.

Это ошибка enter image description here

Вот две части Часов на olApt

enter image description here

enter image description here

ОБНОВЛЕНИЕ 2

Ответ работает на моем ноутбуке, но вылетает на моем рабочем столе (отдельная учетная запись Outlook). Это строка, в которой происходит сбой, и я не хочу, чтобы буква "R" в получателях была заглавной (она автоматически переводится в нижний регистр, несмотря на ввод заглавной буквы).

enter image description here

Также отмечу, что коллекция Recipients на olApt отличается от моего ноутбука до моего рабочего стола:

enter image description here

1 Ответ

1 голос
/ 28 марта 2019

Строка 

Cells(NextRow, "E").Value = olApt.recipients.Address

должна быть заменена на 

.Cells(NextRow, "E").Value = recip.Address

Также имейте в виду, что Outlook Security может блокировать доступ к таким свойствам, как SenderEmailAddress или Recipients, еслиантивирусное приложение не установлено или устарело.Смотри https://docs.microsoft.com/en-us/office/vba/outlook/how-to/security/security-behavior-of-the-outlook-object-model

...