Question

我想，当你打开Outlook时，昨晚关闭的所有电子邮件都要重新打开。

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

如果它们可以成为VB 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

然后我创建了另一个运行计时器的模块并记录到my documents文件夹中的文件。这似乎非常有效

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属性而不是inspector属性）。

感谢 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

改编自this thread

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

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

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

3 个答案: