[英]Import Shared Group Outlook Calendar Appointments to Excel
I want to import the appointments in a shared group Outlook calendar to Excel.我想将共享组 Outlook 日历中的约会导入 Excel。
I used the GetSharedDefaultFolder
but I received the following error:我使用了GetSharedDefaultFolder
但收到以下错误:
You can not open the mailbox because this address book entry does not match an email user.您无法打开邮箱,因为此地址簿条目与电子邮件用户不匹配。
Sub ResolveName()
' déclaration des variables
Dim outlookApp As Outlook.Application
Dim myNamespace As Outlook.Namespace
Dim myRecipient As Outlook.Recipient
Dim CalendarFolder As Outlook.folder
Dim calendarApp As Outlook.AppointmentItem
Dim calendarItem As Outlook.Items
Dim i As Long
Set outlookApp = New Outlook.Application
Set myNamespace = outlookApp.GetNamespace("MAPI")
Set myRecipient = myNamespace.CreateRecipient("dp-TECCR-FormationdesrepartiteursCCRediteurs@hydro.qc.ca")
i = 2
myRecipient.Resolve
Range("A1:D1").Value = Array("Subject", "from", "date", "location")
If myRecipient.Resolved Then
Set CalendarFolder = myNamespace.GetSharedDefaultFolder(myRecipient, olFolderCalendar)
For Each calendarApp In CalendarFolder.Items
Cells(i, 1).Value = calendarItem.Subject
Cells(i, 2).Value = calendarItem.Start
Cells(i, 3).Value = calendarItem.End
Cells(i, 4).Value = calendarItem.Location
Cells(i, 5).Value = calendarItem.MeetingStatus
i = i + 1
Next
End If
Set outlookApp = Nothing
Set myNamespace = Nothing
Set myRecipient = Nothing
Set CalendarFolder = Nothing
Set calendarItem = Nothing
End Sub
Resolve does nothing when you use an email address.当您使用电子邮件地址时,Resolve 没有任何作用。
Use display name / other name property in CreateRecipient
if you want to follow up with a useful If myRecipient.Resolved Then
.如果您想跟进有用的If myRecipient.Resolved Then
在CreateRecipient
使用显示名称/其他名称属性。
Option Explicit
Sub ResolveName()
' déclaration des variables
Dim outlookApp As Outlook.Application
Dim myNamespace As Outlook.Namespace
Dim myRecipient As Outlook.Recipient
Dim CalendarFolder As Outlook.Folder
Dim calendarApp As Outlook.AppointmentItem
Dim calendarItem As Outlook.Items
Dim i As Long
Set outlookApp = New Outlook.Application
Set myNamespace = outlookApp.GetNamespace("MAPI")
Set myRecipient = myNamespace.CreateRecipient("nothingvalid@hydro.qc.ca")
i = 2
myRecipient.Resolve
'Range("A1:D1").Value = Array("Subject", "from", "date", "location")
If myRecipient.Resolved Then
Debug.Print "Anything that looks like an email address will Resolve."
Debug.Print "Use display name / other name property."
'Set CalendarFolder = myNamespace.GetSharedDefaultFolder(myRecipient, olFolderCalendar)
'For Each calendarApp In CalendarFolder.Items
' Cells(i, 1).Value = calendarItem.Subject
' Cells(i, 2).Value = calendarItem.Start
' Cells(i, 3).Value = calendarItem.End
' Cells(i, 4).Value = calendarItem.Location
' Cells(i, 5).Value = calendarItem.MeetingStatus
' i = i + 1
' Next
End If
Set outlookApp = Nothing
Set myNamespace = Nothing
Set myRecipient = Nothing
Set CalendarFolder = Nothing
Set calendarItem = Nothing
End Sub
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.