如何使用用户为预设主题选择的时间在 Outlook 2013 中创建宏约会？
How can I macro Appointment creation in Outlook 2013 with user selected times for pre-set Subjects?
我有一个非常好的 VBA 约会宏，我发现它很久以前就在网上发布了，用于在用户选择的时间和日期创建带有预设参数的新约会日历。
它在 Office 2007 中运行良好，但我们最近转移到 Office 2013 以实现使用 Office 365 企业版（教育版）的制度转变。它完全坏了。权限很好，所以它实际上是 运行（最后：通过调试器进入它进行测试）但它仍然没有做任何事情......甚至没有抛出错误。
宏代码如下：
Private Sub CreateAppt(strSubject, strCategories, strLocation, strBody, bolRemindMe, intRemindMe)
Dim objExpl As Outlook.Explorer
Dim objFolder As Outlook.MAPIFolder
Dim objCB As Office.CommandBarButton
Dim objAppt As Outlook.AppointmentItem
Dim objApptCustom As Outlook.AppointmentItem
On Error Resume Next
Set objExpl = Outlook.Application.ActiveExplorer
If Not objExpl Is Nothing Then
Set objFolder = objExpl.CurrentFolder
If objFolder.DefaultItemType = olAppointmentItem Then
Set objCB = objExpl.CommandBars.FindControl(, 1106)
If Not objCB Is Nothing Then
objCB.Execute
Set objAppt = Outlook.Application.ActiveInspector.CurrentItem
Set objApptCustom = objFolder.Items.Add(olAppointmentItem)
With objApptCustom
.Start = objAppt.Start
.End = objAppt.End
.Subject = strSubject
.Location = strLocation
.Categories = strCategories
.ReminderSet = bolRemindMe
.Body = strBody
If bolRemindMe = True Then
.ReminderMinutesBeforeStart = intRemindMe
End If
.Save
End With
objAppt.Delete
End If
End If
End If
Set objCB = Nothing
Set objAppt = Nothing
Set objApptCustom = Nothing
Set objFolder = Nothing
Set objExpl = Nothing
End Sub
这是由适当填充函数参数的公开宏调用的，例如：
Sub NewSupport()
Call CreateAppt("CMS Open Support", "Support", "Roberts 109", "", True, 20)
End Sub
我试过为 ActiveInspector 显式引用 Outlook.Application，我试过使用全局提供的常量 (olAppointmentItem) 作为 Item 类型而不是字符串 "IPM.Appointment" .
我还尝试使用一些代码来遍历可用的命令和命令栏，以防 Commandbars.FindControl(, 1106) 的 ID 在不同版本之间发生变化，而我得到的只是 Inspector 下的 "Task Pane"预约，ID 5746.
我觉得我 运行 没有想法：在这一点上，即使只是为我指明尝试新事物的正确方向也会很棒。
重复约会将不起作用，因为重复约会需要某种形式的定期结构，而这不是这种情况。
自定义表单可能是一种解决方案，但我真的更喜欢只需单击一个按钮即可为特定约会安排时间跨度 "type"，而无需直接打开约会全部.
Office 2007 宏代码依赖于 CommandBar 操作的问题是 Office 2010 及更高版本不再使用 CommandBars。
This Office DevCenter article 描述了如何更新以前依赖于 CommandBars 的代码以改为使用功能区可扩展性。耶，弃用！
但是等等！在我们踏上重构之路之前，让我们首先回顾一下为什么宏首先使用 CommandBars：在 Office 2007 和更早版本中，无法从用户选择 中获取足够的信息本身—您只能在选择范围内对项目本身进行操作，这不适用于查找已在日历中选择的空白时间跨度的开始和结束时间。
所以宏依赖于从菜单中触发一个新约会（使用 CommandBars 调用），这将自动填充用户选择的开始和停止时间，因为这就是来自新约会命令的方式Outlook 菜单有效。
Office 2010 显然改变了这一点。
您现在可以直接引用用户在“日历”窗格中选择的 [空白] 时间跨度。
我们需要做的就是从 CalendarView 中取出 .SelectedStartTime 和 .SelectedEndTime 并将它们应用于我们的新约会。 Office 开发中心的 CalendarView.SelectedStartTime Property (Outlook) 文章不仅对此进行了明确说明，甚至还附带了示例代码。
对该代码的一些轻微修改会生成一个私有 sub，我们可以将其用作前一个宏的插入，由公开的特定宏调用。
下面的代码与该页面中最初详述的代码有细微的变化，它们是：添加参数，添加 With 段以应用它们，并将新约会直接保存到日历而不是仅保存为 view/editing 打开它。格式稍微好一点。
Private Sub CreateAppointmentUsingSelectedTime(strSubject, strCategories, strLocation, strBody, bolRemindMe, intRemindMe)
Dim datStart As Date
Dim datEnd As Date
Dim oView As Outlook.View
Dim oCalView As Outlook.CalendarView
Dim oExpl As Outlook.Explorer
Dim oFolder As Outlook.Folder
Dim oAppt As Outlook.AppointmentItem
Const datNull As Date = #1/1/4501#
' Obtain the calendar view using
' Application.ActiveExplorer.CurrentFolder.CurrentView.
' If you use oExpl.CurrentFolder.CurrentView,
' this code will not operate as expected.
Set oExpl = Application.ActiveExplorer
Set oFolder = Application.ActiveExplorer.CurrentFolder
Set oView = oExpl.CurrentView
' Check whether the active explorer is displaying a calendar view.
If oView.ViewType = olCalendarView Then
Set oCalView = oExpl.CurrentView
' Create the appointment using the values in
' the SelectedStartTime and SelectedEndTime properties as
' appointment start and end times.
datStart = oCalView.SelectedStartTime
datEnd = oCalView.SelectedEndTime
Set oAppt = oFolder.Items.Add("IPM.Appointment")
With oAppt
.Subject = strSubject
.Location = strLocation
.Categories = strCategories
.ReminderSet = bolRemindMe
.Body = strBody
If bolRemindMe = True Then
.ReminderMinutesBeforeStart = intRemindMe
End If
End With
If datStart <> datNull And datEnd <> datNull Then
oAppt.Start = datStart
oAppt.End = datEnd
End If
oAppt.Save
' oAppt.Display
End If
End Sub
希望这对其他人有帮助，因为我花了比我预期更长的时间（主要是徒劳的搜索，因此在最终隔离问题和解决方案之前将 post 这只是一个问题），甚至在创建新的预设约会时，它可能会在时间上节省我的时间！
我有一个非常好的 VBA 约会宏，我发现它很久以前就在网上发布了，用于在用户选择的时间和日期创建带有预设参数的新约会日历。
它在 Office 2007 中运行良好，但我们最近转移到 Office 2013 以实现使用 Office 365 企业版（教育版）的制度转变。它完全坏了。权限很好，所以它实际上是 运行（最后：通过调试器进入它进行测试）但它仍然没有做任何事情......甚至没有抛出错误。
宏代码如下：
Private Sub CreateAppt(strSubject, strCategories, strLocation, strBody, bolRemindMe, intRemindMe)
Dim objExpl As Outlook.Explorer
Dim objFolder As Outlook.MAPIFolder
Dim objCB As Office.CommandBarButton
Dim objAppt As Outlook.AppointmentItem
Dim objApptCustom As Outlook.AppointmentItem
On Error Resume Next
Set objExpl = Outlook.Application.ActiveExplorer
If Not objExpl Is Nothing Then
Set objFolder = objExpl.CurrentFolder
If objFolder.DefaultItemType = olAppointmentItem Then
Set objCB = objExpl.CommandBars.FindControl(, 1106)
If Not objCB Is Nothing Then
objCB.Execute
Set objAppt = Outlook.Application.ActiveInspector.CurrentItem
Set objApptCustom = objFolder.Items.Add(olAppointmentItem)
With objApptCustom
.Start = objAppt.Start
.End = objAppt.End
.Subject = strSubject
.Location = strLocation
.Categories = strCategories
.ReminderSet = bolRemindMe
.Body = strBody
If bolRemindMe = True Then
.ReminderMinutesBeforeStart = intRemindMe
End If
.Save
End With
objAppt.Delete
End If
End If
End If
Set objCB = Nothing
Set objAppt = Nothing
Set objApptCustom = Nothing
Set objFolder = Nothing
Set objExpl = Nothing
End Sub
这是由适当填充函数参数的公开宏调用的，例如：
Sub NewSupport()
Call CreateAppt("CMS Open Support", "Support", "Roberts 109", "", True, 20)
End Sub
我试过为 ActiveInspector 显式引用 Outlook.Application，我试过使用全局提供的常量 (olAppointmentItem) 作为 Item 类型而不是字符串 "IPM.Appointment" .
我还尝试使用一些代码来遍历可用的命令和命令栏，以防 Commandbars.FindControl(, 1106) 的 ID 在不同版本之间发生变化，而我得到的只是 Inspector 下的 "Task Pane"预约，ID 5746.
我觉得我 运行 没有想法：在这一点上，即使只是为我指明尝试新事物的正确方向也会很棒。
重复约会将不起作用，因为重复约会需要某种形式的定期结构，而这不是这种情况。
自定义表单可能是一种解决方案，但我真的更喜欢只需单击一个按钮即可为特定约会安排时间跨度 "type"，而无需直接打开约会全部.
Office 2007 宏代码依赖于 CommandBar 操作的问题是 Office 2010 及更高版本不再使用 CommandBars。
This Office DevCenter article 描述了如何更新以前依赖于 CommandBars 的代码以改为使用功能区可扩展性。耶，弃用！
但是等等！在我们踏上重构之路之前，让我们首先回顾一下为什么宏首先使用 CommandBars：在 Office 2007 和更早版本中，无法从用户选择 中获取足够的信息本身—您只能在选择范围内对项目本身进行操作，这不适用于查找已在日历中选择的空白时间跨度的开始和结束时间。
所以宏依赖于从菜单中触发一个新约会（使用 CommandBars 调用），这将自动填充用户选择的开始和停止时间，因为这就是来自新约会命令的方式Outlook 菜单有效。
Office 2010 显然改变了这一点。
您现在可以直接引用用户在“日历”窗格中选择的 [空白] 时间跨度。
我们需要做的就是从 CalendarView 中取出 .SelectedStartTime 和 .SelectedEndTime 并将它们应用于我们的新约会。 Office 开发中心的 CalendarView.SelectedStartTime Property (Outlook) 文章不仅对此进行了明确说明，甚至还附带了示例代码。
对该代码的一些轻微修改会生成一个私有 sub，我们可以将其用作前一个宏的插入，由公开的特定宏调用。
下面的代码与该页面中最初详述的代码有细微的变化，它们是：添加参数，添加 With 段以应用它们，并将新约会直接保存到日历而不是仅保存为 view/editing 打开它。格式稍微好一点。
Private Sub CreateAppointmentUsingSelectedTime(strSubject, strCategories, strLocation, strBody, bolRemindMe, intRemindMe)
Dim datStart As Date
Dim datEnd As Date
Dim oView As Outlook.View
Dim oCalView As Outlook.CalendarView
Dim oExpl As Outlook.Explorer
Dim oFolder As Outlook.Folder
Dim oAppt As Outlook.AppointmentItem
Const datNull As Date = #1/1/4501#
' Obtain the calendar view using
' Application.ActiveExplorer.CurrentFolder.CurrentView.
' If you use oExpl.CurrentFolder.CurrentView,
' this code will not operate as expected.
Set oExpl = Application.ActiveExplorer
Set oFolder = Application.ActiveExplorer.CurrentFolder
Set oView = oExpl.CurrentView
' Check whether the active explorer is displaying a calendar view.
If oView.ViewType = olCalendarView Then
Set oCalView = oExpl.CurrentView
' Create the appointment using the values in
' the SelectedStartTime and SelectedEndTime properties as
' appointment start and end times.
datStart = oCalView.SelectedStartTime
datEnd = oCalView.SelectedEndTime
Set oAppt = oFolder.Items.Add("IPM.Appointment")
With oAppt
.Subject = strSubject
.Location = strLocation
.Categories = strCategories
.ReminderSet = bolRemindMe
.Body = strBody
If bolRemindMe = True Then
.ReminderMinutesBeforeStart = intRemindMe
End If
End With
If datStart <> datNull And datEnd <> datNull Then
oAppt.Start = datStart
oAppt.End = datEnd
End If
oAppt.Save
' oAppt.Display
End If
End Sub
希望这对其他人有帮助，因为我花了比我预期更长的时间（主要是徒劳的搜索，因此在最终隔离问题和解决方案之前将 post 这只是一个问题），甚至在创建新的预设约会时，它可能会在时间上节省我的时间！