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 ClassClass 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