[英]Creating MS outlook appointment for shared calendars
最近我处理了为我自己的日历创建 MS Outlook 约会:
VBA Excel 将日期单元格与 Outlook 日历事件同步
现在我想让它在整个公司共享的日历中运行。
当我切换到共享日历(位于 Outlook 外部的日历文件夹)时,我收到如下错误:
我的代码如下所示:
Sub CalendarOutlookScheduleMail()
Dim objOutlook As Outlook.Application
Dim OutlookMail As Outlook.MailItem
Dim objNamespace As Outlook.Namespace
Dim items As Outlook.items
Dim objCalendar As Outlook.Folder, objapt As Outlook.AppointmentItem
Dim Sbj As String, Job As String
Dim Unit As Integer
Dim Dt As Date
Dim dtr As Range
Job = ThisWorkbook.Sheets("Sheet1").Range("AB2")
Sbj = ThisWorkbook.Sheets("Sheet1").Range("AB4")
Dt = DateValue(dtr)
Const olFolderCalendar = 9
Const olAppointmentItem = 1 '1 = Appointment
Set objOutlook = CreateObject("Outlook.Application")
Set OutlookMail = objOutlook.CreateItem(olMailItem)
'Set calFolder = olNS.GetSharedDefaultFolder(objOwner, olFolderCalendar)
Set objNamespace = objOutlook.GetNamespace("MAPI")
Set items = objNamespace.GetDefaultFolder(olFolderCalendar).items
Set objCalendar = objNamespace.GetDefaultFolder(olFolderCalendar).Folders("MDU VM") 'target calendar
Survey
Set items = objCalendar.items
Set objapt = items.add(olAppointmentItem)
objapt.Subject = Sbj '"Test" 'Owner
objapt.Start = Dt + TimeValue("09:00:00")
objapt.Duration = 60 * 8 'Duration(in minutes) OR End(I'm not sure so try both)
objapt.End = Dt + TimeValue("17:30:00")
objapt.Save
End Sub
我扫了一眼:
Set objCalendar = objNamespace.GetDefaultFolder(olFolderCalendar).Folders("MDU VM")
和
Set objCalendar = objNamespace.GetSharedDefaultFolder(olFolderCalendar).Folders("MDU VM")
根据以下链接中的提示:
https://docs.microsoft.com/en-us/office/vba/api/outlook.namespace.getshareddefaultfolder
但现在我收到一个错误:类型不匹配
我想我以错误的方式使用了GetSharedDefaultFolder
。
谁能帮我?
我想让这个代码也为共享的 outlook 日历运行。
NameSpace.GetSharedDefaultFolder function 返回一个Folder
object,它代表指定用户的指定默认文件夹,并采用两个参数。 例如:
Sub ResolveName()
Dim myNamespace As Outlook.NameSpace
Dim myRecipient As Outlook.Recipient
Dim CalendarFolder As Outlook.Folder
Set myNamespace = Application.GetNamespace("MAPI")
Set myRecipient = myNamespace.CreateRecipient("Eugene Astafiev")
myRecipient.Resolve
If myRecipient.Resolved Then
Call ShowCalendar(myNamespace, myRecipient)
End If
End Sub
Sub ShowCalendar(myNamespace, myRecipient)
Dim CalendarFolder As Outlook.Folder
Set CalendarFolder = myNamespace.GetSharedDefaultFolder(myRecipient, olFolderCalendar)
CalendarFolder.Display
End Sub
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.