如何打开当前打开项目的文件夹并选择该项目？

Question

我有一个Sub可以打开当前打开的邮件项目的文件夹。

如果我打开了一个项目，但更改了其间的邮件文件夹，并且想要立即再次打开正确的文件夹，则这是有意义的。

Sub ordner_mail_oeffnen()
    On Error GoTo exit_sub
    'Dim olApp As Outlook.Application
    Dim olitem As Outlook.mailitem
    'Set olApp = Outlook.Application
    Set olitem = Outlook.Application.ActiveInspector.CurrentItem

    Dim olfolder As MAPIFolder
    Dim FolderPath As String
    Dim Subfolder As Outlook.MAPIFolder
    FolderPath = GetPath(olitem)
    Set olfolder = GetFolder(FolderPath)
    olfolder.Display

    'those two lines are just for test purpose
    MsgBox "jetzt"
    Application.ActiveExplorer.ClearSelection

    Sleep (10000)
    Application.ActiveExplorer.ClearSelection
    'here comes the runtime-error (I try to translate) "-2147467259 (80004005) element can not be activated or deactivated, as id does not exist in the current view"
    Application.ActiveExplorer.AddToSelection olitem 
exit_sub:
exit_sub:
End Sub

只有在出现错误之后，才会打开新文件夹，但不会选择某些邮件。

Answer 1

使用Explorer.ClearSelection和Explorer.AddToSelection选择一个项目。

当前资源管理器是从Application.ActiveExplorer返回的。

Answer 2

您可以继续使用GetPath(olitem)和GetFolder(FolderPath)，但是因为没有包含代码，所以我不能确定。

用Set ActiveExplorer = olfolder替换olfolder.Display。

没有GetPath(olitem)和GetFolder(FolderPath)。

Option Explicit

Sub ordner_mail_oeffnen()

    Dim olitem As Object
    Dim olfolder As Folder

    Set olitem = ActiveInspector.CurrentItem
    Set olfolder = olitem.Parent
    Set ActiveExplorer = olfolder

    ActiveExplorer.ClearSelection
    ActiveExplorer.AddToSelection olitem

End Sub

Answer 3

我也遇到了同样的问题，我发现必须给Outlook一些时间来启动新的显示。这可以使用DoEvents来完成。对我来说，以下方法是可行的：

Option Explicit
Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal Milliseconds As LongPtr)
Sub ordner_mail_oeffnen()
    
    Dim olitem As Outlook.MailItem
    Set olitem = Outlook.Application.ActiveInspector.CurrentItem

    Dim olfolder As MAPIFolder
    Set olfolder = olitem.Parent
    
    olfolder.Display
    
    'Sleep 10000             ' does not help
    'MsgBox ("Interruption") ' does not help
    DoEvents                 ' Important!

    If Application.ActiveExplorer.IsItemSelectableInView(olitem) = False Then
        Stop ' We should not get here!
             ' But we will, if the line <DoEvents> is missing.
    End If
    
    Application.ActiveExplorer.ClearSelection
    Application.ActiveExplorer.AddToSelection olitem
End Sub

如果省略DoEvents，代码将运行到Stop命令中。以前的Sleep或MsgBox不会有帮助。注意:当您逐步调试代码(F8)时，不会出现初始问题。