打开所选消息的文件夹并选择消息

时间:2014-10-29 01:44:09

标签: vba outlook

在“所有Outlook项目”中搜索项目时,会显示找到的消息/项目。部分搜索结果项包括邮件所在的文件夹。我尝试打开项目所在的父文件夹的新窗口,然后在新窗口中突出显示该邮件。以下代码打开文件夹,但我无法弄清楚如何找到并选择项目。

'Opens folder in new windows of current messages folder location
 Public Sub OpenFolderPath()
  Dim obj As Object
  Dim objOLApp As Outlook.Application
  Dim objExp As Outlook.Explorer
  Dim F As Outlook.MAPIFolder
  Dim Msg$
  Dim SelMsg As MailItem
  Set obj = Application.ActiveWindow
  If TypeOf obj Is Outlook.Inspector Then
    Set obj = obj.CurrentItem
  Else
    Set obj = obj.Selection(1)
  End If
  Set F = obj.Parent
  Msg = "The path is: " & F.Name & vbCrLf
  Msg = Msg & "Switch to the folder?"
  If MsgBox(Msg, vbYesNo) = vbYes Then
    Set objExp = Application.Explorers.Add(F, olFolderDisplayNormal)
    objExp.Activate
  End If
' The following does not work
  For Each SelMsg In objExp.CurrentFolder.Items
    If obj.EntryID = SelMsg.EntryID Then
        MsgBox SelMsg.EntryID
' What to put here to select the found item.
    End If
  Next
End Sub

2 个答案:

答案 0 :(得分:1)

以下代码将起作用:

'Opens folder in new windows of current messages folder location
 Public Sub OpenFolderPath()
  Dim obj As Object
  Dim objOLApp As Outlook.Application
  Dim objExp As Outlook.Explorer
  Dim F As Outlook.MAPIFolder
  Dim Msg$
  Dim SelMsg As MailItem
  Dim i as Long
  Set obj = Application.ActiveWindow
  If TypeOf obj Is Outlook.Inspector Then
    Set obj = obj.CurrentItem
  Else
    Set obj = obj.Selection(1)
  End If
  Set F = obj.Parent
  Msg = "The path is: " & F.Name & vbCrLf
  Msg = Msg & "Switch to the folder?"
  If MsgBox(Msg, vbYesNo) = vbYes Then
    Set objExp = Application.Explorers.Add(F, olFolderDisplayNormal)
    objExp.Activate
  End If

  'Wait for the user interface to catch up 
  '  (Wait for the new window to finish displaying)
  DoEvents 

  objExp.ClearSelection
  For Each SelMsg In objExp.CurrentFolder.Items
    If obj.EntryID = SelMsg.EntryID Then
        objExp.AddToSelection SelMsg
    End If
  Next

End Sub

答案 1 :(得分:-1)

'Opens folder in new windows of current messages folder location
 Public Sub OpenFolderPath()
  Dim obj As Object
  Dim objOLApp As Outlook.Application
  Dim objExp As Outlook.Explorer
  Dim F As Outlook.MAPIFolder
  Dim Msg$
  Dim SelMsg As MailItem
  Dim i as Long
  Set obj = Application.ActiveWindow
  If TypeOf obj Is Outlook.Inspector Then
    Set obj = obj.CurrentItem
  Else
    Set obj = obj.Selection(1)
  End If
  Set F = obj.Parent
  Msg = "The path is: " & F.Name & vbCrLf
  Msg = Msg & "Switch to the folder?"
  If MsgBox(Msg, vbYesNo) = vbYes Then
    Set objExp = Application.Explorers.Add(F, olFolderDisplayNormal)
    objExp.Activate
  End If
' The following does not work
  i = 1
  For Each SelMsg In objExp.CurrentFolder.Items
    If obj.EntryID = SelMsg.EntryID Then
        MsgBox objExp.CurrentFolder.Items.Item(i)
' What to put here to select the found item.
    End If
    i = i + 1
  Next
End Sub