当 Outlook 加载以打开 Outlook 上次关闭时打开的所有电子邮件时

Question

我希望当您打开 Outlook 时，您昨晚关闭时打开的所有电子邮件都可以重新打开。

我到处寻找并试图挖掘对象试图找到消息 ID，但到目前为止都失败了。

如果它们可以是由 Application_Quit() 和 Application_Startup() 过程调用的 VBAModule、ThisOutlookSession 那就太好了，

谢谢

Answer 1

我从一堆不同的来源将其拼凑在一起......本质上有一个计时器，可以记录我的文档文件夹中日志中每分钟打开的内容。然后可以检索它

Private Sub Application_Quit()
  If TimerID <> 0 Then Call DeactivateTimer 'Turn off timer upon quitting **VERY IMPORTANT**
End Sub

Private Sub Application_Startup()
  Get_Last_Open_Emails
  Call ActivateTimer(1) 'Set timer to go off every 1 minute
End Sub

然后我创建了另一个模块，该模块运行计时器并将记录记录到我的文档文件夹中的文件中。这看起来很有效

Option Explicit
Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerfunc As Long) As Long
Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
Public TimerID As Long 'Need a timer ID to eventually turn off the timer. If the timer ID <> 0 then the timer is running


Sub Get_Open_EntryID()

Dim fso As Object
Dim oFile As Object
Dim oApp As New Outlook.Application
Dim oins As Outlook.Inspector

    Set fso = CreateObject("Scripting.FileSystemObject")
    Set oFile = fso.CreateTextFile(CreateObject("WScript.Shell").specialfolders("MyDocuments") & "\Outlook_Reload.tmp")

    For Each oins In oApp.Inspectors

        oFile.WriteLine oins.CurrentItem.EntryID

    Next
    oFile.Close
    Set fso = Nothing
    Set oFile = Nothing

End Sub

Sub Get_Last_Open_Emails()

Dim FileNum As Integer
Dim DataLine As String
Dim App
Dim NS
Dim Item

FileNum = FreeFile()
Open CreateObject("WScript.Shell").specialfolders("MyDocuments") & "\Outlook_Reload.tmp" For Input As #FileNum
Set App = CreateObject("Outlook.Application")
Set NS = App.GetNamespace("MAPI")
NS.Logon

    While Not EOF(FileNum)
        Line Input #FileNum, DataLine ' read in data 1 line at a time
        Set Item = NS.GetItemFromID(DataLine)
        Item.Display
    Wend

End Sub

Public Sub ActivateTimer(ByVal nMinutes As Long)
    nMinutes = nMinutes * 1000 * 60 'The SetTimer call accepts milliseconds, so convert to minutes
    If TimerID <> 0 Then Call DeactivateTimer 'Check to see if timer is running before call to SetTimer
    TimerID = SetTimer(0, 0, nMinutes, AddressOf TriggerTimer)
    If TimerID = 0 Then
        MsgBox "The timer failed to activate."
    End If
End Sub

Public Sub DeactivateTimer()
Dim lSuccess As Long
    lSuccess = KillTimer(0, TimerID)
    If lSuccess = 0 Then
        MsgBox "The timer failed to deactivate."
    Else
        TimerID = 0
    End If
    End Sub

Public Sub TriggerTimer(ByVal hwnd As Long, ByVal uMsg As Long, ByVal idevent As Long, ByVal Systime As Long)
    'MsgBox "The TriggerTimer function has been automatically called!"
    Get_Open_EntryID
End Sub

Answer 2

您可以检查下面的示例以访问打开的窗口吗？

sub check()

Dim oApp As New Outlook.Application
Dim oins As Outlook.Inspector

    For Each oins In oApp.Inspectors

    MsgBox oins.Caption

    Next

end sub

如果您想访问邮件项目属性，

sub check()

Dim oApp As New Outlook.Application
Dim oins As Outlook.Inspector

    For Each oins In oApp.Inspectors

    MsgBox oins.CurrentItem.Subject        
    Next

end sub

我认为此解决方案将解决您的问题，稍后您可以管理如何存储数据和打开项目。如果您想使用唯一 ID，您可以使用

oins.CurrentItem.EntryID

希望它有帮助。

问候
布拉克

Answer 3

--------- 编辑以下 Remou 的评论 ---------

新代码：

Sub test()
Dim myInspectors As Outlook.Inspectors
Dim x As Integer
Dim iCount As Integer

Set myInspectors = Application.Inspectors
iCount = Application.Inspectors.Count
If iCount > 0 Then
    For x = 1 To iCount
        'check for message only
        If InStr(1, myInspectors.Item(x).Caption, "Message (HTML)") > 0 Then
            ' MsgBox myInspectors.Item(x).EntryID
            MsgBox myInspectors.Item(x).Caption
        End If
    Next x
Else
    MsgBox "No inspector windows are open."
End If
End Sub

然而，一些警告：

• 我没有找到访问检查员源代码的方法对象（即消息）来检查这是否是消息
• 我也没有找到访问 EntryID 的方法（因为它是消息属性而不是检查器属性）。

感谢 Remou 指出了一些很棒的技巧（抱歉，我用我对 Outlook VBA 的实际知识进行了尝试）。

-------- 原始答案 --------

这是一种循环遍历所有 Outlook 窗口的方法：

Option Explicit

Declare Function EnumWindows Lib "user32" (ByVal lpFunc As Long, ByVal lParam As Long) As Long
Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal nMaxCount As Long) As Long

Public Function EnumWindProc(ByVal hWnd As Long, ByVal lParam As Long) As Long
    Dim strTitle As String
    Dim lngTemp As Long

    strTitle = String(255, 0)
    lngTemp = GetWindowText(hWnd, strTitle, 255)
    If InStr(1, Left(strTitle, lngTemp), "Message (HTML)") > 0 Then
        lngOutlookHWnd = hWnd
        MsgBox (strTitle)
    End If
    EnumWindProc = 1
End Function

Public Sub GetOutlookHWnd()
    EnumWindows AddressOf EnumWindProc, 0
End Sub

改编自 此帖子

然而，您仍然需要找到一种存储消息的方法（可以使用 Remou 建议的 EntryID） ) 之后重新打开它。

如果您找到完整的工作解决方案，请告诉我们。