我使用此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
而且我仍然收到下面的错误。
这是olApt上的手表的两个部分
更新2
答案在我的笔记本电脑上有效,但在我的桌面(单独的Outlook帐户)上崩溃。这是它崩溃的行,但我不是不会让收件人中的“ R”成为大写字母(尽管键入大写字母,它也会自动变为小写字母)。
我还注意到,olApt上的“收件人”集合在笔记本电脑上与台式机不同:
答案 0 :(得分:1)
行
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