以下宏在升级到 Microsoft Office Professional Plus 2013 之前有效。
此宏以前的完整功能:
先决条件:
对于每一个动作(的FlagDayAfterTomorrow
,FlagNextWeek
等等),我在Microsoft Outlook中的快速访问工具栏的图标。
对于已发送/接收的电子邮件,我单击其中一个引用图标,然后会发生两件事:
使用 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
如果没有自动提醒,您可以尝试自己设置一个。
代码是理论上的,因为我的设置中不存在所有这些。
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
本文收集自互联网,转载请注明来源。
如有侵权,请联系 [email protected] 删除。
我来说两句