excel - 为共享日历创建 MS Outlook 约会
问题描述
最近我处理了为我自己的日历创建 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函数返回一个对象,该对象代表指定用户的指定默认文件夹,并采用两个参数。Folder
例如:
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
推荐阅读
- ssh - Plink 命令在哪里查找私钥?
- pytest - pytest/mixer Django - 夹具从另一个模型继承时忽略字段值
- java - 如何在 EditText 中添加数字分隔符
- java - 如何将两个或多个字符串数组列表的排列组合创建为一个组合列表
- laravel - 在 Laravel 5.7 中修改 getRouteKeyName
- javascript - Phaser3 + ES6 类:如何保持范围从创建到更新
- html - 如何在 HTML 中以列方式组合两个框架并使其成为一个可滚动页面?
- vuejs2 - 封装使用类语法的 vue 组件
- laravel - laravel vuejs/axios put request Formdata 为空
- python - 如何找到最优化的 if 语句序列?