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

Question

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

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

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

感谢

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

如果您想访问 mailitem 属性

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 的方法（因为它是 Message 属性而不是检查器属性）。

感谢Remou指出了一些很棒的技巧（抱歉，我尝试了一下我对 Outlook VBA 的实际了解）。

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

这是一种遍历所有 Outlook Windows 的方法：

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）以便之后重新打开它。

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