Когда Outlook загружается, чтобы открыть все электронные письма, которые были открыты во время последнего закрытия Outlook

Question

Мне бы хотелось, чтобы при открытии Outlook все электронные письма, которые вы открывали, когда он был закрыт вчера вечером, были открыты заново.

Я посмотрел везде и пытался копаться в Объектах, пытаясьнайти сообщение iD, но пока что не получилось.

Было бы неплохо, если бы они могли быть в VBAModule, ThisOutlookSession, вызываемом процедурами 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

Я думаю, что это решение решит вашу проблему, позже вы сможете управлять тем, как хранить данные и открывать элементы. Если вы хотите использовать уникальный идентификатор, вы можете использовать

oins.CurrentItem.EntryID

Надеюсь, это поможет.

С уважением Бурак

Answer 3

--------- Изменить после комментария Рему ---------

Новый код:

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).

-------- Оригинальный ответ --------

Вот способ перебрать все окна Windows 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

Адаптировано с этой темы

Тем не менее, вам все равно нужно найти способ сохранить сообщение (можно использовать EntryID, как предложено Рему), чтобы открыть его потом.

Пожалуйста, дайте нам знать, если вы найдете полное рабочее решение.