When Outlook loads to open all emails that were open when Outlook last closed

I would like, when you open Outlook, all the emails you had open when it was closed last night, to re-open.

I have looked everywhere and have tried to dig through the Object开发者_StackOverflow社区s trying to find message iD, but have so far failed.

It would be nice if they could in be the VBAModule, ThisOutlookSession called by the Application_Quit() and Application_Startup() procedures

With thanks

I pieced this together from a bunch of different sources... essentially having a timer that records every minute what is open in a log in the my documents folder. This can then be retrieved

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

Then I created another module that runs the timer and records to a file in the my documents folder. This seems pretty effective

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

Can you check please below example to have access open windows?

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

If you want to have access to mailitem properties

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

I think this solution will solve your problem, later you can manage how to store data and open items. If you want to use unique ID you can use

oins.CurrentItem.EntryID

Hope its helps.

Regards Burak

--------- Edit following to Remou's comment ---------

New code:

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

Yet, some caveats:

• I didn't find a way to access the inspector's source object (i.e. Message) to check if this is a message
• I also didn't find a way to access the EntryID (because it is a Message property and not an inspector property).

Thanks to Remou for pointing out some great tips (sorry, I gave a try with my actual knowledge of Outlook VBA).

-------- Original Answer --------

Here is a way to loop through all the 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

Adapted from this thread

Yet, you still have to find a way to store the message (could use the EntryID as suggested by Remou) to re-open it afterwards.

Please let us know if you find a full working solution.