Question

我有一个宏，它可以在收件箱（Outlook 2016）中读取新电子邮件的邮件项目，并弹出带有主题和时间的msg框，效果很好。但是，如果msgbox处于活动状态，同时有新的电子邮件到达邮箱，则无法使用。有什么方法可以立即弹出用于最新电子邮件的下一个msgbox？

我尝试通过将宏添加到自定义功能区中来手动运行宏，但由于它是私有功能，因此无法正常工作。

Option Compare Text
Private WithEvents myOlItems  As Outlook.Items

        Private Sub Application_Startup()
            Dim olApp As Outlook.Application
            Dim objNS As Outlook.NameSpace
              Set olApp = Outlook.Application
              Set objNS = olApp.GetNamespace("MAPI")
Set myOlItems = objNS.GetDefaultFolder(olFolderInbox).Items
        End Sub

        Private Sub myOlItems_ItemAdd(ByVal item As Object)

        On Error GoTo ErrorHandler

          Dim Msg As Outlook.MailItem

          If TypeName(item) = "MailItem" Then
            Set Msg = item

            If Msg.subject Like "*abc.com*" Then
                MsgBox "This is a priority email" & vbCrLf & vbCrLf & "Subject: " & Msg.subject & vbCrLf & "At: " & Msg.SentOn, vbOKOnly, "Priority Email" 'Msg.Subject & vbCrLf & Msg.Body
                ElseIf Msg.Body Like "*abc.com*" Then
                    MsgBox "This is a priority email" & vbCrLf & "Subject: " & Msg.subject & vbCrLf & "At: " & Msg.SentOn, vbOKOnly, "Priority Email" 'Msg.Subject & vbCrLf & Msg.Body
                    ElseIf Msg.SenderEmailAddress Like "*abc.com*" Or Msg.CC Like "*abc.com*" Then
                        MsgBox "This is a priority email" & vbCrLf & "Subject: " & Msg.subject & vbCrLf & "At: " & Msg.SentOn, vbOKOnly, "Priority Email" 'Msg.Subject & vbCrLf & Msg.Body

            End If
          End If

        ProgramExit:
          Exit Sub
        ErrorHandler:
          MsgBox Err.Number & " - " & Err.Description
          Resume ProgramExit
        End Sub

Answer 1

对于不阻止ItemAdd代码的提示：

dim priorityMail as mailitem

Set priorityMail = CreateItem(olMailItem)
With priorityMail
    .Subject = This is a priority email & Msg.subject
    .Body = "At: " & Msg.SentOn & vbCrLf & vbCrLf & Msg.Body
    .display
End With

用于读取新电子邮件的mailitem的Outlook宏

1 个答案: