在Outlook约会中循环收件人

问题描述 投票:0回答:1

我使用这个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

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

我还注意到olApt上的Recipients集合在我的笔记本电脑上与我的桌面不同:

enter image description here

excel vba outlook
1个回答
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

© www.soinside.com 2019 - 2024. All rights reserved.