Late-bound Event Sink: works with Word, not with Outlook. Why?

[VBobCat]

Dear friends, I need your help with solving this puzzle.

I wanted to wrap Word and Outlook interop code in classes that work regardless of Office Version on target user machines.
For that reason, I chose late binding instead of adding reference to a specific PIA.

Much with help of examples found on web, I wrote two classes, AutoWord and AutoOutlook, and their code follows below. Both execute well, that is, both run their commands against both Word and Outlook, so I can open documents and send e-mails, ok.

But I also wanted to listen to some events raised by these external applications. So I also included implementation for Event Interfaces of both applications, from their GUID, and their events DispId. Once again, I relied a lot on samples found in the web.

What puzzles me, however, is that only AutoWord worked fine, and I can listen to MS-Word events. AutoOutlook, in the other hand, fails on executing the IConnectionPoint.Advise command, which would link it to the Event Sink.

If I comment and neutralize that single line, the class starts to work, but event-deaf.

Can someone point what is going wrong here?

Thank you very much!


Class AutoWord

Imports System.Reflection
Imports System.Runtime.CompilerServices
Imports System.Runtime.InteropServices
<ClassInterface(ClassInterfaceType.None)> _
Public Class AutoWord
    Implements IApplicationEvents2
    Implements IDisposable

    Private wordApplication As Object
    Private mConnectionPoint As ComTypes.IConnectionPoint
    Private mSinkCookie As Integer
    Public Sub New()
        Renew()
    End Sub
    Private Sub Renew()
        wordApplication = CreateObject("Word.Application")
        DirectCast(wordApplication, ComTypes.IConnectionPointContainer).FindConnectionPoint( _
           GetType(IApplicationEvents2).GUID, mConnectionPoint)
        mConnectionPoint.Advise(Me, mSinkCookie)
        wordApplication.Visible = True
    End Sub
    Public Sub Close()
        overrideDocumentBeforeClose = True
        wordApplication.Documents.Close(0)
        wordApplication.Quit(0)
        wordApplication = Nothing
    End Sub
    Public ReadOnly Property Active As Boolean
        Get
            Return wordApplication IsNot Nothing
        End Get
    End Property
    Public ReadOnly Property Documents() As String()
        Get
            Dim DD As New List(Of String)
            Dim DC As Integer = wordApplication.Documents.Count()
            Dim DI As Object
            If DC > 0 Then
                For i = 1 To DC
                    DI = wordApplication.Documents.Item(i)
                    DD.Add(DI.Name)
                Next
            End If
            Return DD.ToArray
        End Get
    End Property
    Public Function AddDocument(ByVal full_name As String) As String
        Dim DI As Object = Nothing
        Try
            DI = wordApplication.Documents.Add(full_name)
        Catch ex As Exception
        End Try
        If DI IsNot Nothing Then Return DI.Name
        Return Nothing
    End Function
    Public Function OpenDocument(ByVal full_name As String) As String
        Dim _objDocument As Object = Nothing
        Dim _fileName As Object = full_name
        Dim _confirmConversions As Object = False
        Dim _readOnly As Object = False
        Dim _addToRecentFiles As Object = False
        Dim _revert As Object = False
        Dim _format As Object = 0
        Dim _encoding As Object = 50001
        Dim _visible As Object = True
        Dim _openAndRepair As Object = True
        Dim _documentDirection As Object = 0
        Dim _nNoEncodingDialog As Object = True
        Try
            _objDocument = wordApplication.Documents.Open(_fileName, _confirmConversions, _readOnly, _addToRecentFiles, , , _revert, , , _format, _encoding, _visible, _openAndRepair, _documentDirection, _nNoEncodingDialog)
        Catch ex As Exception
            Stop
        End Try
        If _objDocument IsNot Nothing Then Return _objDocument.Name
        Return Nothing
    End Function
    Public Sub SaveDocument(ByVal item_name As String)
        Dim DI As Object = Nothing
        Try
            DI = wordApplication.Documents.Item(item_name)
        Catch ex As Exception
        End Try
        If DI IsNot Nothing Then DI.Save()
    End Sub
    Public Function SaveDocumentAs(ByVal item_name As String, ByVal new_full_name As String) As String
        Dim DI As Object = Nothing
        Try
            DI = wordApplication.Documents.Item(item_name)
        Catch ex As Exception
        End Try
        If DI IsNot Nothing Then
            DI.SaveAs(new_full_name)
            Return DI.Name
        End If
        Return Nothing
    End Function
    Public Sub DocumentFindReplace(ByVal item_name As String, ByVal dfr As Dictionary(Of String, String))
        Dim SL = New List(Of Object), FI As Object
        Dim DI As Object = Nothing, SC As Integer
        Try
            DI = wordApplication.Documents.Item(item_name)
        Catch ex As Exception
        End Try
        If DI IsNot Nothing Then
            SC = DI.StoryRanges.Count
            If SC > 0 Then
                For i = 1 To SC
                    SL.Add(DI.StoryRanges.Item(i))
                Next
            End If
        End If
        Dim _findText As Object
        Dim _matchCase As Object = False
        Dim _matchWholeWord As Object = False
        Dim _matchWildcards As Object = False
        Dim _matchSoundsLike As Object = False
        Dim _matchAllWordForms As Object = False
        Dim _forward As Object = True
        Dim _wrap As Object = 1
        Dim _format As Object = False
        Dim _replaceWith As Object
        Dim _replace As Object = 2
        Dim _matchKashida As Object = False
        Dim _matchDiacritics As Object = False
        Dim _matchAlefHamza As Object = False
        Dim _matchControl As Object = False
        For Each SR In SL
            FI = SR.Find
            For Each KVP In dfr
                _findText = KVP.Key
                _replaceWith = KVP.Value
                FI.Execute(
                    _findText,
                    _matchCase,
                    _matchWholeWord,
                    _matchWildcards,
                    _matchSoundsLike,
                    _matchAllWordForms,
                    _forward,
                    _wrap,
                    _format,
                    _replaceWith,
                    _replace,
                    _matchKashida,
                    _matchDiacritics,
                    _matchAlefHamza,
                    _matchControl)
            Next
        Next
    End Sub

    Public Event Quit(ByVal sender As Object, ByVal e As EventArgs)
    Public Sub OnQuit() Implements IApplicationEvents2.Quit
        wordApplication = Nothing
        RaiseEvent Quit(Me, New EventArgs)
    End Sub

    Public Event DocumentChange(ByVal sender As Object, ByVal e As EventArgs)
    Public Sub OnDocumentChange() Implements IApplicationEvents2.DocumentChange
        RaiseEvent DocumentChange(Me, New EventArgs)
    End Sub

    Public Event DocumentOpen(ByVal sender As Object, ByVal e As DocumentOpenEventArgs)
    Public Sub OnDocumentOpen(ByVal doc As Object) Implements IApplicationEvents2.DocumentOpen
        RaiseEvent DocumentOpen(Me, New DocumentOpenEventArgs(doc))
    End Sub

    Public Class DocumentOpenEventArgs
        Inherits EventArgs
        Public Sub New(ByVal document As Object)
            _doc = document
        End Sub
        Private _doc As Object
        Public ReadOnly Property Document As Object
            Get
                Return _doc
            End Get
        End Property
    End Class

    Private overrideDocumentBeforeClose As Boolean
    Public Event DocumentBeforeClose(ByVal sender As Object, ByVal e As DocumentBeforeCloseEventArgs)
    Public Sub OnDocumentBeforeClose(ByVal doc As Object, ByRef cancel As Boolean) Implements IApplicationEvents2.DocumentBeforeClose
        Dim DBCEA = New DocumentBeforeCloseEventArgs(doc)
        RaiseEvent DocumentBeforeClose(Me, DBCEA)
        cancel = DBCEA.Cancel And Not overrideDocumentBeforeClose
    End Sub
    Public Class DocumentBeforeCloseEventArgs
        Inherits EventArgs
        Public Sub New(ByVal document As Object)
            _doc = document
        End Sub
        Private _doc As Object
        Public ReadOnly Property Document As Object
            Get
                Return _doc
            End Get
        End Property
        Public Property Cancel As Boolean
    End Class


#Region "IDisposable Support"
    Private disposedValue As Boolean

    Protected Overridable Sub Dispose(ByVal disposing As Boolean)
        If Not Me.disposedValue Then
            If disposing Then
                RemoveConnection()
            End If
            If Me.Active Then Me.Close()
        End If
        Me.disposedValue = True
    End Sub

    Public Sub Dispose() Implements IDisposable.Dispose
        Dispose(True)
        GC.SuppressFinalize(Me)
    End Sub
    Public Sub RemoveConnection()
        If mConnectionPoint IsNot Nothing AndAlso mSinkCookie <> 0 Then
            mConnectionPoint.Unadvise(mSinkCookie)
        End If
        mConnectionPoint = Nothing
        mSinkCookie = 0
    End Sub
#End Region

    <ComImport(), Guid("000209FE-0000-0000-C000-000000000046"), TypeLibType(CShort(4304))> _
    Private Interface IApplicationEvents2
        <MethodImpl(MethodImplOptions.InternalCall), DispId(2)> _
        Sub Quit()

        <MethodImpl(MethodImplOptions.InternalCall), DispId(3)> _
        Sub DocumentChange()

        <MethodImpl(MethodImplOptions.InternalCall), DispId(4)> _
        Sub DocumentOpen(<InAttribute(), MarshalAs(UnmanagedType.Interface)> ByVal doc As Object)

        <MethodImpl(MethodImplOptions.InternalCall), DispId(6)> _
        Sub DocumentBeforeClose(<InAttribute(), MarshalAs(UnmanagedType.Interface)> ByVal doc As Object,
                            <InAttribute(), Out(), MarshalAs(UnmanagedType.Interface)> ByRef cancel As Boolean)
    End Interface
End Class

Class AutoOutlook

Imports System.Reflection
Imports System.Runtime.CompilerServices
Imports System.Runtime.InteropServices
<ClassInterface(ClassInterfaceType.None)> _
Public Class AutoOutlook
    Implements IApplicationEvents
    Implements IDisposable

    Private outlookApplication
    Private outlookNamespace As Object
    Private mConnectionPoint As ComTypes.IConnectionPoint
    Private mSinkCookie As Integer

    Public Sub New()
        Renew()
    End Sub
    Private Sub Renew()
        Try
            outlookApplication = GetObject(, "Outlook.Application")
        Catch ex As Exception
            outlookApplication = CreateObject("Outlook.Application")
        End Try
        TryCast(outlookApplication, ComTypes.IConnectionPointContainer).FindConnectionPoint( _
           GetType(IApplicationEvents).GUID, mConnectionPoint)

           ' mConnectionPoint.Advise(Me, mSinkCookie)
           ' the line above doesn't execute in this class and I don't know why

        outlookNamespace = outlookApplication.GetNamespace("MAPI")
        outlookNamespace.Logon()
    End Sub
    Public ReadOnly Property Active As Boolean
        Get
            Return outlookApplication IsNot Nothing
        End Get
    End Property
    Public Sub Test()
        Dim PF = outlookNamespace.PickFolder
        Stop
    End Sub
    Public Function SendMessageHTML(ByVal _to As String, ByVal _subject As String, ByVal _htmlBody As String, ByVal _attachments As String()) As Boolean
        Try
            Dim olMail As Object
            olMail = outlookApplication.CreateItem(0)
            olMail.To = _to
            olMail.Subject = _subject
            olMail.BodyFormat = 2
            olMail.HTMLBody = _htmlBody
            For Each _file In _attachments
                If IO.File.Exists(_file) Then
                    olMail.Attachments.Add(_file, 1)
                End If
            Next
            olMail.Send()
            olMail = Nothing
            Return True
        Catch ex As Exception
            Return False
        End Try
    End Function

    <ComImport(), Guid("0006304E-0000-0000-C000-000000000046"), TypeLibType(CShort(4304))> _
    Private Interface IApplicationEvents
        <MethodImpl(MethodImplOptions.InternalCall), DispId(61442)> _
        Sub ItemSend(<InAttribute(), MarshalAs(UnmanagedType.Interface)> ByVal item As Object,
                     <InAttribute(), Out(), MarshalAs(UnmanagedType.Interface)> ByRef cancel As Boolean)

        <MethodImpl(MethodImplOptions.InternalCall), DispId(&HF003)> _
        Sub NewMail()

        <MethodImpl(MethodImplOptions.InternalCall), DispId(&HF006)> _
        Sub Startup()

        <MethodImpl(MethodImplOptions.InternalCall), DispId(&HF007)> _
        Sub Quit()

    End Interface

    Private Sub OnStartup() Implements IApplicationEvents.Startup
        Stop
    End Sub

    Private Sub OnQuit() Implements IApplicationEvents.Quit
        Stop
    End Sub

    Private Sub OnItemSend(ByVal item As Object, ByRef cancel As Boolean) Implements IApplicationEvents.ItemSend
        Stop
    End Sub

    Private Sub OnNewMail() Implements IApplicationEvents.NewMail
        Stop
    End Sub


#Region "IDisposable Support"
    Private disposedValue As Boolean
    Protected Overridable Sub Dispose(ByVal disposing As Boolean)
        If Not Me.disposedValue Then
            If disposing Then
                RemoveConnection()
            End If
        End If
        Me.disposedValue = True
    End Sub
    Public Sub Dispose() Implements IDisposable.Dispose
        Dispose(True)
        GC.SuppressFinalize(Me)
    End Sub
    Public Sub RemoveConnection()
        If mConnectionPoint IsNot Nothing AndAlso mSinkCookie <> 0 Then
            mConnectionPoint.Unadvise(mSinkCookie)
        End If
        mConnectionPoint = Nothing
        mSinkCookie = 0
    End Sub
#End Region

End Class