在ThisOutlookSession中实现接口在Office 2013中不起作用

时间:2014-08-29 18:59:03

标签: vba outlook-vba

我有一个我编写的Outlook宏,当我将它们移动到文件夹时会自动将项目标记为已读。 (我讨厌在收件箱以外的文件夹中保留未读邮件。)我在Outlook 2010中编写了宏,并且它已经运行了好几年。

我最近升级到Office 2013,现在我的宏无法正常工作 - 我在此行上遇到类型不匹配错误(请参阅下面的完整代码):

Set oMoveHandler.Callback = Me

oMoveHandler.Callback期望一个对象实现的IMessageMoved类型的对象,所以我不确定为什么我会收到此错误。有什么想法吗?

ThisOutlookSession代码:

Option Explicit

Implements IMessageMoved

Private m_oFolderCollection As Collection

Private Sub Application_Quit()
    Set m_oFolderCollection = Nothing
End Sub

Private Sub Application_Startup()
    Dim oFolder As Outlook.Folder

    Set m_oFolderCollection = New Collection
    For Each oFolder In Application.GetNamespace("MAPI").Folders
        Call AddFolder(oFolder)
    Next oFolder
End Sub

Private Sub AddFolder(Folder As Outlook.Folder)
    Dim oFolder As Outlook.Folder
    Dim oMoveHandler As MoveHandler

    If Folder Is Nothing Then
        Exit Sub
    End If

    If Folder.Folders.Count = 0 Then
        Exit Sub
    End If

    For Each oFolder In Folder.Folders
        If oFolder.DefaultItemType = olMailItem Then
            If oFolder.Name <> "Inbox" And oFolder.Name <> "Outbox" And oFolder.Name <> "ePrescribing Workgroup" Then
                Set oMoveHandler = New MoveHandler
                Set oMoveHandler.Folder = oFolder.Items
                Set oMoveHandler.Callback = Me
                Call m_oFolderCollection.Add(oMoveHandler)
                Set oMoveHandler = Nothing
            End If
            Call AddFolder(oFolder)
        End If
    Next oFolder
End Sub

Private Function IMessageMoved_MessageMoved(Item As Object) As Variant
    On Error Resume Next
    Item.UnRead = False
    On Error GoTo 0
End Function

IMessageMoved:

Public Function MessageMoved(Item As Object)
End Function

MoveHandler:

Private WithEvents m_oFolder As Outlook.Items
Private m_oCallback As IMessageMoved

Public Property Set Folder(Folder As Outlook.Items)
    Set m_oFolder = Folder
End Property

Public Property Get Folder() As Outlook.Items
    Set Folder = m_oFolder
End Property

Public Property Set Callback(Object As IMessageMoved)
    Set m_oCallback = Object
End Property

Private Sub Class_Terminate()
    Set m_oFolder = Nothing
    Set m_oCallback = Nothing
End Sub

Private Sub m_oFolder_ItemAdd(ByVal Item As Object)
    If Not m_oCallback Is Nothing Then
        Call m_oCallback.MessageMoved(Item)
    End If
End Sub

1 个答案:

答案 0 :(得分:0)

我怀疑我实际上遇到了与in this post describing a similar problem in Excel所描述的类似问题,其中绑定并没有按预期工作。为了解决这个问题,我最终将我的界面从ThisOutlookSession移到了一个单独的类中,然后我只是从ThisOutlookSession实例化。