循环Outlook约会中的收件人

时间:2019-03-28 01:03:48

标签: excel vba outlook

我使用此code并尝试访问每个Outlook约会的Recipients(电子邮件地址和显示名称),但出现错误:

  

运行时错误'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

更新

我尝试了

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

我还注意到,olApt上的“收件人”集合在笔记本电脑上与台式机不同:

enter image description here

1 个答案:

答案 0 :(得分:1)

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

必须替换为

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

还请记住,如果未安装防病毒应用程序或过期,则Outlook Security会阻止访问诸如SenderEmailAddressRecipients之类的属性。参见https://docs.microsoft.com/en-us/office/vba/outlook/how-to/security/security-behavior-of-the-outlook-object-model