☰

仅在阅读回复/转发窗格时在文件夹窗格中弹出电子邮件？

tag-icon • tag-icon microsoft-outlook vba
仅在阅读回复/转发窗格时在文件夹窗格中弹出电子邮件？

我有一个代码，我想（手动运行代码后）将文件夹窗格中的电子邮件弹出到弹出窗口中。我只希望它在我当前起草回复/转发时执行此操作。

现在，只要此代码位于回复/转发文件夹窗格中，我运行它时它就可以正常工作。但是，当我再次运行代码或电子邮件已在回复中弹出时，它会将原始电子邮件作为另一个弹出窗口打开，而不是在回复或转发中。

我需要做什么来确保此代码不会在已经弹出电子邮件以供回复/转发时打开原始电子邮件的弹出窗口？：

Sub PopOutReplyOrForward()

'Not perfected, It needs to not open up the same email if it is already in a Reply/Forward Mode.

    On Error Resume Next
    
    Dim explorer As Outlook.explorer
    Dim selection As Outlook.selection
    Dim item As Object
    
    ' Get the active Explorer window
    Set explorer = Application.ActiveExplorer
    
    ' Check if anything is selected
    If Not explorer Is Nothing And explorer.selection.Count > 0 Then
        ' Get the selected item
        Set selection = explorer.selection
        
        ' Loop through selected items
        For Each item In selection
            ' Check if the selected item is a mail item and is a reply or forward
            If TypeOf item Is Outlook.mailItem And (item.ReplyOrForward = olReply Or item.ReplyOrForward = olReplyAll Or item.ReplyOrForward = olForward) Then
                ' Open the item in a new window
                item.GetInspector.Activate
            End If
        Next item
    Else
        ' Inform the user that no appropriate item is selected
        MsgBox "No valid reply or forward email selected!", vbExclamation
    End If
End Sub

答案1

Per 表示，目标是确保您的代码不会打开同一封电子邮件两次。也许可以添加一些约束（草稿）看看是否可行，

  • 添加循环来检查所有打开的检查员看看他们中是否有人有同样的条目编号作为选定项目，并且也处于回复/转发模式。
  • 如果没有找到现有窗口，我们将继续在新窗口中打开该项目。

我快速扭曲了你的片段，看看它是否适合你。

'// 2023.12.11 - Added double checking active/non-active senarios;
'// 2023.12.11 - Added MailItem check;
'//'
Sub PopOutReplyOrForward()

    Dim explorer As Outlook.Explorer
    Dim selection As Outlook.Selection
    Dim item As Object
    Dim inspector As Outlook.Inspector
    Dim existingWindow As Outlook.Inspector

    Set explorer = Application.ActiveExplorer

    If Not explorer Is Nothing And explorer.Selection.Count > 0 Then

        Set selection = explorer.Selection

        For Each item In selection

            If item.Class = olMail Then

                Set existingWindow = Nothing

                For Each inspector In Application.Inspectors
                    If inspector.CurrentItem.EntryID = item.EntryID Then
                        Set existingWindow = inspector
                        Exit For
                    End If
                Next inspector

                If existingWindow Is Nothing Then
                    If Left(item.Subject, 3) = "RE:" Or Left(item.Subject, 3) = "FW:" Then
                        item.Display
                    End If
                Else
                    MsgBox "Email is already open!", vbInformation
                End If

            End If
        Next item
    Else
        MsgBox "No valid email selected!", vbExclamation
    End If

End Sub

答案2

我能够通过引用活动窗口来获得所需的结果。 如果活动窗口位于文件夹窗格中，则它将弹出。 如果活动窗口已弹出，它将不执行任何操作：

Sub PopOutEmailIfNotAlready()

    On Error Resume Next
    
    Dim explorer As Outlook.explorer
    Dim selection As Outlook.selection
    Dim item As Object
    
    ' Get the active Explorer window
    Set explorer = Application.ActiveExplorer
    
    ' Check if anything is selected
    If Not explorer Is Nothing And explorer.selection.Count > 0 Then
        ' Get the selected item
        Set selection = explorer.selection
        
        ' Loop through selected items
        For Each item In selection
            ' Check if the active window is an Inspector
            If Application.ActiveWindow.Class = olInspector Then
                ' If it's an Inspector, do nothing
            Else
                ' If it's an Explorer, open the item in a new window
                item.GetInspector.Activate
            End If
        Next item
        
    Else
        ' Inform the user that no appropriate item is selected
        MsgBox "No valid reply or forward email selected!", vbExclamation
    End If
End Sub

相关内容