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

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.

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)