CODEWITHSUNDEEP
excelvbaoutlook
Al Grant
Al Grant

Reputation: 2354

Looping over recipients in a Outlook Appointments

I using this code and trying to access the Recipients (Email Address and also Display Name) of each Outlook Appointment but getting a Error:

Run-time error '287' Application-defined or object-defined error

This error is highlighted on the line : For Each recip In 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

I tried 

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

And I still get the errors below.

This is the error enter image description here

Here are two parts of the Watch on olApt

enter image description here

enter image description here

UPDATE 2

The answer works on my laptop but crashes on my desktop (seperate outlook account). This is the line it crashes on, and I not it wont let the "R" in recipients be a captial (it changes to lower case automatically despite typing a captial).

enter image description here

I also note that the Recipients collection on olApt is different on my laptop to my desktop:

enter image description here

Upvotes: 0

Views: 364

Answers (1)

Dmitry Streblechenko
Dmitry Streblechenko

Reputation: 66286

The line 

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

must be replaced with 

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

Also keep in mind that Outlook Security can blocks access to properties such as SenderEmailAddress or Recipients if an antivirus app is not installed or is out of date. See https://learn.microsoft.com/en-us/office/vba/outlook/how-to/security/security-behavior-of-the-outlook-object-model

Upvotes: 1

Related Questions