时间戳

首页 > 解决方案 > 如何使用 Microsoft Office Profession Plus 2013 在 MarkAsTask 项目上创建提醒？

vba - 如何使用 Microsoft Office Profession Plus 2013 在 MarkAsTask 项目上创建提醒？

问题描述

以下宏在升级到 Microsoft Office Professional Plus 2013 之前有效。

此宏以前的完整功能：

先决条件：

对于每个操作（FlagDayAfterTomorrow等FlagNextWeek），我在 Microsoft Outlook 的快速访问工具栏中创建了一个图标。

对于已经发送/接收的电子邮件，我单击其中一个引用图标，会发生两件事：

  1. 邮件被标记为带有参考日期的待办事项
  2. 在参考日期和定义的时间，邮件将出现在“提醒”框中。

在 Microsoft Office Professional Plus 2013 中，只有 1 号有效。没有提醒出现。

我必须做些什么才能使 #2 与此版本的 Outlook 一起工作？

'**********************************************************
'Declarations section of the module
'**********************************************************
'      Option Explicit

Public Enum FlagWhatEnum
  flNextWeek = 0
  flThisEvening = 1
  flTomorrow = 2
  flDayAfterTomorrow = 3
End Enum

Public Sub FlagNextWeek()
  FlagItem flNextWeek
End Sub

Public Sub FlagThisEvening()
  FlagItem flThisEvening
End Sub

Public Sub FlagTomorrow()
  FlagItem flTomorrow
End Sub
Public Sub FlagDayAfterTomorrow()
  FlagItem flDayAfterTomorrow
End Sub

Public Sub FlagItem(FlagWhat As FlagWhatEnum)
  Dim Mail As Outlook.MailItem
  Dim obj As Object
  Dim Sel As Outlook.Selection
  Dim Item As Object
  Dim i&
  Dim dt As Date
  Dim tm As String
  Dim Icon As OlMarkInterval

  Select Case FlagWhat
  Case flNextWeek
    dt = DateAdd("d", 7, Date)
    tm = CStr(dt) & " 15:00"
    Icon = olMarkNextWeek
  Case flThisEvening
    dt = Date
    tm = CStr(dt) & " 15:00"
    Icon = olMarkToday
  Case flTomorrow
    dt = DateAdd("d", 1, Date)
    tm = CStr(dt) & " 15:00"
    Icon = olMarkTomorrow
  Case flDayAfterTomorrow
    dt = DateAddW(Date, 2)
    tm = CStr(dt) & " 15:00"
    Icon = olMarkDayAfterTomorrow
  End Select

  Set obj = Application.ActiveWindow
  If TypeOf obj Is Outlook.Explorer Then
    Set Sel = obj.Selection
    For i = 1 To Sel.Count
      Set obj = Sel(i)
      If TypeOf obj Is Outlook.MailItem Then
        Set Mail = obj
        Mail.MarkAsTask Icon
        Mail.TaskStartDate = tm
        Mail.TaskDueDate = tm
        Mail.Save
      End If
    Next

  Else
    Set obj = obj.CurrentItem
    If TypeOf obj Is Outlook.MailItem Then
      Set Mail = obj
      Mail.MarkAsTask olMarkNextWeek
      Mail.TaskStartDate = tm
      Mail.TaskDueDate = tm
      Mail.Save
    End If
  End If
End Sub

' https://support.microsoft.com/en-us/kb/115489
'==========================================================
' The DateAddW() function provides a workday substitute
' for DateAdd("w", number, date). This function performs
' error checking and ignores fractional Interval values.
'==========================================================
Function DateAddW(ByVal TheDate, ByVal Interval)

    Dim Weeks As Long, OddDays As Long, Temp As String

    If VarType(TheDate) <> 7 Or VarType(Interval) < 2 Or _
      VarType(Interval) > 5 Then
        DateAddW = TheDate
    ElseIf Interval = 0 Then
        DateAddW = TheDate
    ElseIf Interval > 0 Then
        Interval = Int(Interval)

        ' Make sure TheDate is a workday (round down).
        Temp = Format(TheDate, "ddd")
        If Temp = "Sun" Then
            TheDate = TheDate - 2
        ElseIf Temp = "Sat" Then
            TheDate = TheDate - 1
        End If

        ' Calculate Weeks and OddDays.
        Weeks = Int(Interval / 5)
        OddDays = Interval - (Weeks * 5)
        TheDate = TheDate + (Weeks * 7)

        ' Take OddDays weekend into account.
        If (DatePart("w", TheDate) + OddDays) > 6 Then
            TheDate = TheDate + OddDays + 2
        Else
            TheDate = TheDate + OddDays
        End If

        DateAddW = TheDate
    Else                          ' Interval is < 0
        Interval = Int(-Interval) ' Make positive & subtract later.

        ' Make sure TheDate is a workday (round up).
        Temp = Format(TheDate, "ddd")
        If Temp = "Sun" Then
            TheDate = TheDate + 1
        ElseIf Temp = "Sat" Then
            TheDate = TheDate + 2
        End If

        ' Calculate Weeks and OddDays.
        Weeks = Int(Interval / 5)
        OddDays = Interval - (Weeks * 5)
        TheDate = TheDate - (Weeks * 7)

        ' Take OddDays weekend into account.
        If (DatePart("w", TheDate) - OddDays) < 2 Then
            TheDate = TheDate - OddDays - 2
        Else
            TheDate = TheDate - OddDays
        End If

        DateAddW = TheDate
    End If

End Function

标签： vbaoutlook

解决方案

如果没有自动提醒您可以尝试自己设置一个。

代码是理论上的，因为我的设置中不存在所有这些。

Mail.TaskStartDate = tm
Mail.TaskDueDate = tm

Mail.ReminderSet = True
Mail.ReminderTime = tm

Mail.SAVE

' A saved ReminderTime does not indicate a reminder will trigger.
' No impact in my setup.
Debug.Print .ReminderTime

推荐阅读