在“所有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
答案 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