我使用这个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
我仍然会得到以下错误。
以下是关于olApt手表的两个部分
更新2
答案适用于我的笔记本电脑,但崩溃在我的桌面上(单独的Outlook帐户)。这是它崩溃的线,我不会让收件人中的“R”成为一个资本(尽管输入了一个资本,它会自动变为小写)。
我还注意到olApt上的Recipients集合在我的笔记本电脑上与我的桌面不同:
这条线
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