如何使用用户选择的预设主题时间在Outlook 2013中创建约会创建？

时间：2015-08-19 22:18:18

标签： vba outlook outlook-vba

我有一个非常好的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在不同版本之间发生变化，而我所有的回复都是＆＃34;任务窗格＆＃34;在监察员的任命下，身份证号为5746.

我觉得我的想法已经不多了：即使是一些指向正确方向的东西，也可以尝试新的东西。

定期约会不会起作用，因为那些需要某种形式的常规结构才能重现，但事实并非如此。

自定义表单可能是一个解决方案，但我真的更喜欢能够单击一个按钮来安排特定约会的时间跨度＆＃34;键入＆＃34;而且从来没有直接打开任命。

1 个答案:

答案 0 :(得分：0)

依赖于CommandBar操作的Office 2007宏代码的问题是Office 2010和forward不再使用CommandBars。

This Office DevCenter article介绍了如何更新以前依赖CommandBars的代码，而不是使用功能区扩展性。是的，弃用！

但是等等！在我们开始重构这条路之前，让我们重新审视宏为什么首先使用CommandBars：在Office 2007和之前的版本中，无法从用户选择本身获取足够的信息< / em> - 您只能对选择中的项目进行操作，这不适用于查找在日历中选择的空白时间段的开始和停止时间。

因此宏依赖于从菜单中激活一个新的约会（使用CommandBars调用），这将自动填充用户选择的开始和停止时间，因为这是来自Outlook的新约会命令的方式菜单有效。

Office 2010显然改变了这一点。

您现在可以直接引用用户在“日历”窗格中选择的[空白]时间范围。

我们需要做的就是从.SelectedStartTime获取.SelectedEndTime和CalendarView并将其应用到我们的新约会中。 Office开发人员中心的CalendarView.SelectedStartTime Property (Outlook)文章不仅明确地阐述了这一点，而且还附带了示例代码。

对该代码进行一些轻微的修改会产生一个私有子，我们可以将其用作前一个宏的插入，由公开的特定宏调用。

以下代码对该页面中最初详细说明的代码进行了细微更改，其中包括：添加参数，添加With段以应用它们，以及将新约会直接保存到日历而不是仅打开日历用于查看/编辑。格式稍微好一点。

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

希望这对其他人有所帮助，因为我花了更长的时间（大多数是futiley搜索，因此即将发布这个问题只是一个问题，然后才最终将问题和解决方案隔离开来），而不是我预期的，甚至可能会永远拯救我，创造新的预设约会！

相关问题
最新问题