Using events together with interfaces in VBA

Question

Introduction

Because of the limitation of VBA in using events in interfaces I was searching for a kind of workaround.

For sure I also read this which also provides an approach, but I was searching for an easier way.

I ended up with the following solution.

---

The idea behind

Instead of defining the events directly in an interface - because it is not possible to use them in an implementing class in VBA - I use an additional 'event' class, where all necessary events will be placed in, and which will be injected into the interface implementing classes.

---

Naming of the event class

I'm aware of that this class is not really used as an interface, but it only should be used with the regarding interface. So I named it also with an I prefix. Another benefit of this is that it will be listed beneath the regarding interface.

---

Circular references

The worker object is provided with the event on purpose. As long as it is used in the event handler with care, that means, it should not be stored anywhere else, there shouldn't be any risk regarding circular references.

---

The interfaces

IWorker

Option Explicit
Public Property Set Events(ByRef value As IWorkerEvents)
End Property
Public Sub Work()
End Sub

IWorkerEvents

Option Explicit
Public Event Notify(ByRef worker As IWorker, message As String)
Public Sub Notify(ByRef worker As IWorker, message As String)
 RaiseEvent Notify(worker, message)
End Sub

---

The implementations

Worker1

Option Explicit
Implements IWorker
Private Type TWorker
 Events As IWorkerEvents
End Type
Private this As TWorker
Private Property Set IWorker_Events(RHS As IWorkerEvents)
 Set this.Events = RHS
End Property
Private Sub IWorker_Work()
 Debug.Print "Worker 1 works hard."
 Notify "is working..."
End Sub
Sub Notify(ByVal message As String)
 If Not this.Events Is Nothing Then
 this.Events.Notify Me, message
 End If
End Sub

Worker2

Option Explicit
Implements IWorker
Private Type TWorker
 Events As IWorkerEvents
End Type
Private this As TWorker
Private Property Set IWorker_Events(RHS As IWorkerEvents)
 Set this.Events = RHS
End Property
Private Sub IWorker_Work()
 Debug.Print "Worker 2 works hard."
 Notify "is working..."
End Sub
Sub Notify(ByVal message As String)
 If Not this.Events Is Nothing Then
 this.Events.Notify Me, message
 End If
End Sub

---

Building it together

TestClass

Option Explicit
Dim WithEvents workerEvents As IWorkerEvents
Sub Test()
 Dim worker As IWorker
 Set workerEvents = New IWorkerEvents
 Set worker = New worker1
 Set worker.Events = workerEvents
 worker.Work
 Set worker = New worker2
 Set worker.Events = workerEvents
 worker.Work
End Sub
Private Sub workerEvents_Notify(worker As IWorker, message As String)
 Debug.Print "TestClass says:", TypeName(worker), message
End Sub

TestModule

Option Explicit
Sub Test()
 With New testClass
 .Test
 End With
End Sub

---

Output

Worker 1 works hard.

TestClass says: Worker1 is working...

Worker 2 works hard.

TestClass says: Worker2 is working...

• Mathieu Guindon: Wah, that's scary. I could have written this code.. pretty much exactly like that.
• AHeyne: Honestly, I must say, that I'm really affected by your way of coding style, since I read here. And because your articles are really pleasant to read, I 'stole' this style too. mea culpa ;-)
• ThunderFrame: It's worth taking a look at this SO question, and several of the answers - stackoverflow.com/questions/41023670/…

Answer 1

I use an additional 'event' class, where all necessary events will be placed in, and which will be injected into the interface implementing classes.

That. That is how it's done. It's COM-friendly, it works, and it's simple. Beautiful.

From Option Explicit to the names of literally everything, including that private type and that this field. You could open any of my own VBA projects and see exactly that, it's almost scary.

I only have a few minor points, that Rubberduck would have picked up:

• Public access modifier is sometimes explicit, often implicit.
• Not sure why IWorkerEvents parameter needs to be passed ByRef.
• Not sure why Message parameter needs to be passed ByRef.

With the next Rubberduck release, you could also have @Description annotations, that the add-in automatically translates to VB_Description attributes, for example:

'@Description "Sets the event provider object for this instance."
Public Property Set Events(ByRef value As IWorkerEvents)
End Property
'@Description "Executes the worker."
Public Sub Work()
End Sub

These special comments (well, the actual description string) would then be visible in the object browser's bottom panel, and in Rubberduck's context-sensitive selection command bar, whenever an IWorker member is selected anywhere in the code.

The write-only Events property is also a little flag: it prompts for a better design - a factory method off a default instance comes to mind:

Option Explicit
'@PredeclaredId
Implements IWorker
Private Type TWorker
 Events As IWorkerEvents
End Type
Private this As TWorker
'@Description "Creates a new worker instance."
Public Function Create(ByVal workerEvents As IWorkerEvents) As IWorker
 If workerEvents Is Nothing Then Err.Raise 5, "IWorkerEvents instance cannot be Nothing."
 With New Worker1
 Set .Events = workerEvents
 Set Create = .Self
 End With
End Function
'@Description "Gets this instance through the IWorker interface. Used by the Create method."
Public Property Get Self() As IWorker
 Set Self = Me
End Property
'@Description "Gets or sets the worker events. Useless from default instance."
Friend Property Get Events() As IWorkerEvents
 Set Events = this.Events
End Property
Friend Property Set Events(ByVal value As IWorkerEvents)
 Set this.Events = value
End Property
Private Sub IWorker_Work()
 If this.Events Is Nothing Then Err.Raise 5, "Instance was not created with .Create method."
 Debug.Print "Worker 1 works hard."
 this.Events.Notify Me, "is working..."
End Sub

The IWorker interface then looks like this:

Option Explicit
Public Sub Work()
End Sub

So the client code is written against IWorker and only sees a Work method, and that's really all they need to care about.

Guard clauses ensure the object is always in a valid state and prevent misusing the class.

The Worker1 concrete class has a VB_PredeclaredId attribute, which exposes the Create method, so the code that New's up a Worker1 class can do this instead:

With Worker1.Create(workerEvents)
 .Work
End With

The fact that Events is visible from a Worker1 instance is not a problem, because the client code does not work from that interface, it only ever sees IWorker members; the Friend modifiers could just as well be Public, but there's no point exposing them beyond this VBAProject, so Friend is good enough.

Notice I removed the Notify procedure (which was implicitly Public), because it's really just an implementation detail that doesn't need to be exposed, and can very well simply be inlined in the Work method.

Until the next Rubberduck release, the module and member attributes need to be added manually, by exporting the module, editing them in, and then re-importing the module.

---

I like seeing test code. VBA code that works off interfaces and injected dependencies want to be tested! With Rubberduck you could have written unit tests that actually document the implementation/specs, for example in some Worker1Tests module:

Option Explicit
Option Private Module
'@TestModule
'@Folder "Tests"
Private Assert As New Rubberduck.AssertClass
Private Fakes As New Rubberduck.FakesProvider
'@TestMethod
Public Sub GivenNullWorkerEvents_Throws()
 Const ExpectedError As Long = 5
 On Error GoTo TestFail
 Dim sut As Worker1
 Set sut = New Worker1
 If Not sut.Events Is Nothing Then Assert.Inconclusive "Events should be Nothing"
 sut.Work
Assert:
 Assert.Fail "Expected error was not raised."
TestExit:
 Exit Sub
TestFail:
 If Err.Number = ExpectedError Then
 Resume TestExit
 Else
 Resume Assert
 End If
End Sub

This simple test passes when the Work method raises run-time error 5 because the object wasn't created with the Create function.

Another test would pass when the Work method would raise the Notify event on a fake implementation of the IWorkerEvents class, ensuring that the Worker1 class is calling the Notify member on the IWorkerEvents object it's given.

And so on: a robust test suite would cover pretty much every single execution path, and clearly document how the class should (and shouldn't) be used.

A single "here, see, it works" test doesn't really do anything other than exercising the "happy path" - which is ok for showing off a prototype, but production code needs all cases covered.

• AHeyne: Not sure why IWorkerEvents parameter needs to be passed ByRef. Not sure why Message parameter needs to be passed ByRef. You are right, both should be ByVal. Yes! Your factory method approach/paradigm... I just forgot to implement it. I really like it and absolutely agree, that it should be applied here. :-) Notice I removed the 'Notify' procedure (which was implicitly Public) Yes, in my example it should have been private. Public access modifier is sometimes explicit, often implicit. What do you mean with that? I can't follow exactly.
• AHeyne: Regarding the mentioned Rubberduck features (comments, test code): I really would like to use Rubberduck, but unfortunately all versions from 2.0.10 to 2.0.13 cause "Microsoft Access is attempting to recover your Information..." when closing Access after using the VBE. This happens on two different PCs. :-/
• AHeyne: And: Thank you for your great answer! BTW: Replying to an answer by using comments is really hard. Should I have answered instead of commenting?
• Mathieu Guindon: @UnhandledException absolutely don't use answers for commenting, it'll get downvoted and flagged, and you don't want that. RE public access modifier: when Public isn't explicitly specified, it's implicit - e.g. Sub Foo is implicitly public in VBA, but implicitly private in VB.NET; I'm basically just saying you should prefer consistently explicit access modifiers.
• Mathieu Guindon: RE Rubberduck crashing Access - there's a known, rather tricky issue involving docked toolwindows and how they position themselves (see #2936), and it's possible that the configuration file just needs to be deleted/regenerated, #2878.

Answer 2

My 'final' solution

Finally I ended with this solution now, where I added your suggestions and some more things (see below).

It implements the Create method (with usage of the VB_PredeclaredId attribute) in the IWorker implementations.

---

Error enumeration and module error base

Also I implemented an error enumeration in combination with a module error base.

Therefore I enhanced the interface IWorker to store that in a central purposeful location.

---

Rubberduck features

No Rubberduck features are included yet, but I 'enhanced' the TestClass a bit to show the error handling in action.

---

Error handling labels

The keywords Catch and Finally are a matter of taste, but I like them. They are literary based on C# exception handling and just indicate clean label names for their purpose, like other call CleanFail and CleanExit.

---

Comments

Another personal flavor is how I 'prefix' comments.

'// My comment.

This is also based on C/C# and for me the additional slashes // make it more clear in visibility that here is a comment.

---

Methodname constant

Another thing I like and use is, if necessary, to use a constant to store the name of the current method.

Const METHODNAME = "MyMethodname"

I like to have this in a constant, especially if it is used more then once in a method, for example in error handling.

---

The interfaces

IWorker

Option Explicit
Private Const ERROR_BASE As Long = &H400
Public Enum IWorkerError
 IWorkerEventsInstanceCannotBeNothing = vbObjectError + ERROR_BASE
 InstanceWasNotCreatedWithCreateMethod
End Enum
Public Sub Work()
End Sub

IWorkerEvents

Option Explicit
Public Event Notify(ByVal worker As IWorker, ByVal message As String)
Public Sub Notify(ByVal worker As IWorker, ByVal message As String)
 RaiseEvent Notify(worker, message)
End Sub

---

The implementation (only for one worker now)

Worker1

'// Attribute "VB_PredeclaredId" needs to be set to true.
Option Explicit
Implements IWorker
Private Type TWorker
 Events As IWorkerEvents
End Type
Private this As TWorker
Public Function Create(ByVal Events As IWorkerEvents) As IWorker
 Const METHODNAME = "Create"
 If Events Is Nothing Then OnIWorkerEventsInstanceCannotBeNothing GetErrorSource(METHODNAME)
 With New Worker1
 Set .Events = Events
 Set Create = .Self
 End With
End Function
Friend Property Get Self() As IWorker
 Set Self = Me
End Property
Friend Property Get Events() As IWorkerEvents
 Set Events = this.Events
End Property
Friend Property Set Events(ByVal value As IWorkerEvents)
 Set this.Events = value
End Property
Private Sub IWorker_Work()
 Const METHODNAME = "IWorker_Work"
 If this.Events Is Nothing Then OnInstanceWasNotCreatedWithCreateMethod GetErrorSource(METHODNAME)
 Debug.Print "Worker1 works hard."
 this.Events.Notify Me, "is working..."
End Sub
Private Sub OnIWorkerEventsInstanceCannotBeNothing(ByVal source As String)
 Err.Raise IWorkerError.IWorkerEventsInstanceCannotBeNothing, source, "IWorkerEvents instance cannot be Nothing."
End Sub
Private Sub OnInstanceWasNotCreatedWithCreateMethod(ByVal source As String)
 Err.Raise IWorkerError.InstanceWasNotCreatedWithCreateMethod, source, "Instance was not created with .Create method."
End Sub
Private Function GetErrorSource(ByVal method As String) As String
 GetErrorSource = TypeName(Me) & "." & method
End Function

Building it together

TestClass

Option Explicit
Private WithEvents workerEvents As IWorkerEvents
Public Sub Test()
 On Error GoTo Catch
 Set workerEvents = New IWorkerEvents
 TestTwoWorkers
 TestWorkerCreateWithParameterNothing
 TestWorkerWithoutCreateMethod
Finally:
 Exit Sub
Catch:
 Select Case Err.Number
 Case IWorkerError.InstanceWasNotCreatedWithCreateMethod
 Debug.Print Err.Description, "(" & Err.source & ")"
 Resume Next
 Case IWorkerError.IWorkerEventsInstanceCannotBeNothing
 Debug.Print Err.Description, "(" & Err.source & ")"
 Resume Next
 Case Else
 Debug.Print Err.Number & " : " & Err.Description, "(" & Err.source & ")"
 End Select
 Resume Finally
End Sub
Private Sub TestTwoWorkers()
 With Worker1.Create(workerEvents)
 .Work
 End With
 With Worker2.Create(workerEvents)
 .Work
 End With
End Sub
Private Sub TestWorkerCreateWithParameterNothing()
 With Worker2.Create(Nothing)
 .Work
 End With
End Sub
Private Sub TestWorkerWithoutCreateMethod()
 Dim worker As IWorker
 Set worker = New Worker1
 worker.Work
 Set worker = Nothing
End Sub
Private Sub workerEvents_Notify(ByVal worker As IWorker, ByVal message As String)
 Debug.Print "TestClass says:", TypeName(worker), message
End Sub

---

TestModule

Option Explicit
Sub Test()
 With New testClass
 .Test
 End With
End Sub

---

Output

Worker1 works hard.

TestClass says: Worker1 is working...

Worker2 works hard.

TestClass says: Worker2 is working...

IWorkerEvents instance cannot be Nothing. (Worker2.Create)

Instance was not created with .Create method. (Worker1.IWorker_Work)