使用VBA在Outlook中打开邮件项目的“添加提醒...”对话框？

Posted 2021-05-03

在Win10 64位下使用32位Outlook 2013。

在VBA中，假设我有一个mailitem对象。我知道如果我想创建一个，我可以通过我自己的表单单独设置各种任务/提醒选项。如果我可以使Outlook的“添加提醒...”对话框显示为邮件项目，似乎会更容易，但我没有找到任何引用它。

这是Outlook中显示的对话框：

（顺便说一句，我可以使用myMailItem.ShowCategoriesDialog获取“类别”对话框，但似乎没有任何类似的提醒。）

谢谢！

答案

单击功能区上的“添加提醒”对话框按钮时，根据活动的窗口，它将起作用并将提醒对象（和/或后续对象等）绑定到邮件项目。

如果您没有打开邮件项目，它将把它绑定到收件箱中选择的邮件项目（一个或多个）。默认情况下，只选择一个项目，用灰色或浅蓝色背景突出显示。您可以按住CTRL键并选择更多邮件项，然后单击添加提醒以将提醒应用于所有这些项。

如果邮件项已经打开并处于活动状态，则提醒将仅应用于该邮件项。对于您的情况，似乎您想逐个应用提醒，我们将采用后一种方法。找到我们想要的邮件项，然后打开它，然后打开“添加提醒”对话框，当您点击“确定”时，它将保存并关闭活动窗口。此代码查找最新的邮件项，但您应该能够更改选择条件：

Private Sub PopUpReminderDialogBox()
    Dim iLatest As Long
    Dim myFolder As Object
    Dim myNameSpace As Object
    Dim myItem As Outlook.MailItem
    Dim olApp As Outlook.Application

    Set olApp = Outlook.Application 'you can initiate a New application too
    Set myNameSpace = olApp.GetNamespace("MAPI")
    Set myFolder = myNameSpace.GetDefaultFolder(olFolderInbox)

    iLatest = myFolder.Items.Count
    Set myItem = myFolder.Items(iLatest)

    myItem.Display 'to make the mailitem currentitem
    olApp.ActiveInspector.CommandBars.ExecuteMso ("AddReminder")
    myItem.Close olSave
End Sub

如果您希望在收件箱中突出显示一个或多个邮件项目时有机会打开提醒对话框，那么您需要使用

    olApp.ActiveExplorer.CommandBars.ExecuteMso ("AddReminder")

代替

    olApp.ActiveInspector.CommandBars.ExecuteMso ("AddReminder")

另一答案

谢谢你，@ iibo。这非常有帮助，所以我接受了它作为答案。

这是一个模拟我想要做的宏的模型。每当代码指向不同的文件夹时，它都会更改Outlook UI中可见的资源管理器这一事实在我的情况下很有用，但在一般情况下，最好使用一个根本不使用UI的方法。我只是觉得没有。

<========================== EDITED ====================== ===>

我通过实验发现，更改活动资源管理器中的文件夹实际上需要花费大量时间（从CPU角度来看），所以在很多情况下，资源管理器还没有准备好清除选择并选择所选项目，除非你强制宏等待。通常一两秒就足够了。我修改了代码以允许最多10秒。

我还了解到EntryID作为文件夹的唯一标识符，是使用Is运算符的一个很好的替代方法，只要两个对象没有“设置”相等，它就不起作用。

Public Sub testMSO()

'This test macro selects the last item in the Inbox, but it could be
' any item in any available folder.

Dim loItem As Object
Dim loNewFold As Folder
Dim loOldFold As Folder
Dim loExplorer As Explorer
Dim lbFoldChg As Boolean
Dim liLoops As Integer
Dim ldWait As Date

On Error Resume Next 'Mimimal error handling, just for demonstration purposes

'Get the Inbox folder.
Set loNewFold = Session.GetDefaultFolder(olFolderInbox)

'Get the active explorer.
Set loExplorer = Application.ActiveExplorer

'The current and "new" folders always compare as different using the Is operator
' because Is determines whether two objects were Set equal, so just use the
' unique EntryID to determine if they are really different.
If loExplorer.CurrentFolder.EntryID = loNewFold.EntryID Then
    lbFoldChg = False
Else
    lbFoldChg = True

    'Save the explorer's current folder
    Set loOldFold = loExplorer.CurrentFolder

    'Assign the Inbox to the active explorer. Note that this is preferable to the
    ' loNewFold.Display method, which is disconcerting to the user because it opens
    ' a new explorer (new Outlook window).
    Set loExplorer.CurrentFolder = loNewFold

End If

'Arbitrarily pick the last Inbox item.
Set loItem = loNewFold.Items(loNewFold.Items.Count)

'Make the chosen item the only selected item.
If lbFoldChg Then

    'Selection takes place in the Outlook UI, so if the folder changes, it takes
    ' quite a while in CPU terms to load the explorer and get it ready to change
    ' the selection, so wait up to 10 seconds in 1-second increments.

    For liLoops = 1 To 10
        If loExplorer.IsItemSelectableInView(loItem) Then
            loExplorer.ClearSelection
            loExplorer.AddToSelection loItem
            Exit For
        Else
            ldWait = Now + (1 / 86400)  'Add a second to current date/time
            Do While Now < ldWait
                DoEvents
            Loop
        End If
    Next liLoops

    If liLoops = 11 Then
        MsgBox "Unable to select mail item in folder " & loItem.Parent.Name, _
                vbOKOnly + vbExclamation
        GoTo cleanup
    End If

Else

    'If the folder has not changed, no need to wait.
    loExplorer.ClearSelection
    loExplorer.AddToSelection loItem

End If

'Display the Add Reminder dialog if it is available. It might not be available
' if the item is, for example, an meeting item, or if the chosen folder does
' not support reminders.
If loExplorer.CommandBars.GetEnabledMso("AddReminder") Then
    loExplorer.CommandBars.ExecuteMso "AddReminder"
End If

cleanup:

If lbFoldChg Then
    'Point the explorer back to the original folder.
    Set loExplorer.CurrentFolder = loOldFold
End If

'Clean up
Set loExplorer = Nothing
Set loNewFold = Nothing
Set loOldFold = Nothing
Set loItem = Nothing

End Sub 'testMSO