Making MVVM Work in VBA Part 2: Event Propagation

Using a WithEvents variable to handle the MSForms.Control events of, say, a TextBox control has the irritating tendency to throw a rather puzzling run-time error 459 “Object or class does not support the set of events”. To be honest, I had completely forgotten about this when I started working on this MVVM framework. I had even posted an answer on Stack Overflow and my learning-it-the-hard-way is immortalized on that page.

…there’s a bit of COM hackery going on behind the scenes; there’s enough smokes & mirrors for VBA to successfully compile the above, but, basically, you’re looking at a glitch in The Matrix (Rubberduck’s resolver has similar “nope” issues with MSForms controls): there isn’t any obvious way to get VBA to bind a dynamic control object to its MSForms.Control events.

-Mathieu Guindon, Apr 18 ’19 

What I hadn’t noticed until today, was that another user had posted an answer to that question a few hours later that day – and that answer ultimately leads to the groundbreaking manual wiring-up of what VBA normally does automagically under the hood when we declare a WithEvents variable.

pUnk’d

The code I’m about to share is heavily based on the work shared on Stack Overflow by user Evr, and uses the ConnectToConnectionPoint Win32 API that, it must be mentioned, comes with a caveat:

This function is available through Windows XP and Windows Server 2003. It might be altered or unavailable in subsequent versions of Windows.

Regardless, it works (for now anyway, …if we lose Mac support for this specific capability).

Rubberduck uses similar connection points to handle a number of VBE events that aren’t otherwise exposed, so I knew this was going to work one way or another. The idea is to pass an IUnknown pointer to an object that exposes members with very specific VB_UserMemId attribute values, and have accordingly very specific member signatures.

This post lists a bunch of such attributes – however since there aren’t any problems with binding regular TextBox and CommandButton events (these do work with simple WithEvents event providers), I’m only interested in these:

EventVB_UserMemId
AfterUpdate-2147384832
BeforeUpdate-2147384831
Enter-2147384830
Exit-2147384829
The VB_UserMemId attribute values for each of the MSForms.Control events.

This is going to be a little bit lower-level than usual, but every VBA user class has an IUnknown pointer, So we can use any class module that has the members with the appropriate VB_UserMemId attribute values, and pass that as the pUnk pointer argument.

So, here’s the punk in question, exactly as I currently have it:

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "ControlEventsPunk"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Description = "Provides an event sink to relay MSForms.Control events."
'@Folder MVVM.Infrastructure.Win32
'@ModuleDescription "Provides an event sink to relay MSForms.Control events."
'based on https://stackoverflow.com/a/51936950
Option Explicit
Implements IControlEvents
Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7) As Byte
End Type
'[This function is available through Windows XP and Windows Server 2003. It might be altered or unavailable in subsequent versions of Windows.]
'https://docs.microsoft.com/en-us/windows/win32/api/shlwapi/nf-shlwapi-connecttoconnectionpoint
#If VBA7 Then
Private Declare PtrSafe Function ConnectToConnectionPoint Lib "shlwapi" Alias "#168" (ByVal Punk As stdole.IUnknown, ByRef riidEvent As GUID, ByVal fConnect As Long, ByVal PunkTarget As stdole.IUnknown, ByRef pdwCookie As Long, Optional ByVal ppcpOut As LongPtr) As Long
#Else
Private Declare Function ConnectToConnectionPoint Lib "shlwapi" Alias "#168" (ByVal punk As stdole.IUnknown, ByRef riidEvent As GUID, ByVal fConnect As Long, ByVal punkTarget As stdole.IUnknown, ByRef pdwCookie As Long, Optional ByVal ppcpOut As Long) As Long
#End If
Private Type TState
    RefIID As GUID 'The IID of the interface on the connection point container whose connection point object is being requested.
    Connected As Boolean
    PunkTarget As Object
    Cookie As Long
    
    Handlers As Collection
End Type
'from https://stackoverflow.com/a/61893857 (same user as #51936950!)
Private Const ExitEventID As Long = -2147384829
Private Const EnterEventID As Long = -2147384830
Private Const BeforeUpdateEventID As Long = -2147384831
Private Const AfterUpdateEventID As Long = -2147384832
Private This As TState
'@Description "Gets/sets the target MSForms.Control reference."
Public Property Get Target() As Object
Attribute Target.VB_Description = "Gets/sets the target MSForms.Control reference."
    Set Target = This.PunkTarget
End Property
Public Property Set Target(ByVal RHS As Object)
    Set This.PunkTarget = RHS
End Property
'@Description "Registers the listener."
Public Function Connect() As Boolean
Attribute Connect.VB_Description = "Registers the listener."
    GuardClauses.GuardNullReference This.PunkTarget, TypeName(Me), "Target is not set."
    ConnectToConnectionPoint Me, This.RefIID, True, This.PunkTarget, This.Cookie, 0&
    This.Connected = This.Cookie <> 0
    Connect = This.Connected
End Function
'@Description "De-registers the listener."
Public Function Disconnect() As Boolean
Attribute Connect.VB_Description = "De-registers the listener."
    If Not This.Connected Then Exit Function
    ConnectToConnectionPoint Me, This.RefIID, False, This.PunkTarget, This.Cookie, 0&
    This.Connected = False
    Disconnect = True
End Function
'@Description "A callback that handles MSForms.Control.AfterUpdate events for the registered target control."
Public Sub OnAfterUpdate()
Attribute OnAfterUpdate.VB_UserMemId = -2147384832
Attribute OnAfterUpdate.VB_Description = "A callback that handles MSForms.Control.AfterUpdate events for the registered target control."
    Dim Handler As IHandleControlEvents
    For Each Handler In This.Handlers
        Handler.HandleAfterUpdate
    Next
End Sub
'@Description "A callback that handles MSForms.Control.BeforeUpdate events for the registered target control."
Public Sub OnBeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
Attribute OnBeforeUpdate.VB_UserMemId = -2147384831
Attribute OnBeforeUpdate.VB_Description = "A callback that handles MSForms.Control.BeforeUpdate events for the registered target control."
    Dim Handler As IHandleControlEvents
    For Each Handler In This.Handlers
        Handler.HandleBeforeUpdate Cancel
    Next
End Sub
'@Description "A callback that handles MSForms.Control.Exit events for the registered target control."
Public Sub OnExit(ByVal Cancel As MSForms.ReturnBoolean)
Attribute OnExit.VB_UserMemId = -2147384829
Attribute OnExit.VB_Description = "A callback that handles MSForms.Control.Exit events for the registered target control."
    Dim Handler As IHandleControlEvents
    For Each Handler In This.Handlers
        Handler.HandleExit Cancel
    Next
End Sub
'@Description "A callback that handles MSForms.Control.Enter events for the registered target control."
Public Sub OnEnter()
Attribute OnEnter.VB_UserMemId = -2147384830
Attribute OnEnter.VB_Description = "A callback that handles MSForms.Control.Enter events for the registered target control."
    Dim Handler As IHandleControlEvents
    For Each Handler In This.Handlers
        Handler.HandleEnter
    Next
End Sub
'@Description "Registers the specified object to handle the relayed control events."
Public Sub RegisterHandler(ByVal Handler As IHandleControlEvents)
Attribute RegisterHandler.VB_Description = "Registers the specified object to handle the relayed control events."
    This.Handlers.Add Handler
End Sub
Private Sub Class_Initialize()
    Set This.Handlers = New Collection
    This.RefIID.Data1 = &H20400
    This.RefIID.Data4(0) = &HC0
    This.RefIID.Data4(7) = &H46
End Sub
Private Sub IControlEvents_OnAfterUpdate()
    OnAfterUpdate
End Sub
Private Sub IControlEvents_OnBeforeUpdate(ByVal Cancel As MSForms.IReturnBoolean)
    OnBeforeUpdate Cancel
End Sub
Private Sub IControlEvents_OnEnter()
    OnEnter
End Sub
Private Sub IControlEvents_OnExit(ByVal Cancel As MSForms.IReturnBoolean)
    OnExit Cancel
End Sub
Private Sub IControlEvents_RegisterHandler(ByVal Handler As IHandleControlEvents)
    RegisterHandler Handler
End Sub

Let’s ignore the IControlEvents interface for now. The class has a Target – that’ll be our TextBox control instance. So we set the Target, and then we can invoke Connect, and when we’re done we can invoke Disconnect to explicitly undo the wiring-up.

Then we have an OnEnter method with VB_UserMemId = -2147384830, which makes it an event handler procedure for MSForms.Control.Enter. The name of the procedure isn’t relevant, but it’s important that the procedure is parameterless.

Similarly, the name of the OnExit procedure has no importance, but it must have a single ByVal Cancel As MSForms.ReturnBoolean parameter (only ByVal and the data type matter). For events that have more than one parameter, the order is also important.

In theory that’s all we need: we could go on and handle Control.Exit in this OnExit procedure, and call it a day. In fact you can probably do that right away – however I need another step for my purposes, because I’m going to need my PropertyBindingBase class to propagate these events “up” to, say, some TextBoxPropertyBinding class that can implement some TextBox-specific behavior for the Control events.

Propagating Events

I had already a working pattern for my INotifyPropertyChange requirements to propagate property changes across objects, and the pattern is applicable here too. See, I could have declared a Public Event Exit(ByRef Cancel As MSForms.ReturnBoolean) on the ControlEventsPunk class, and then I could have used a WithEvents variable to handle them – and that would have worked too. Except I don’t want to use events here, because events work well as implementation details… but they can’t be exposed on an interface, which makes them actually more complicated to work with.

There are two interfaces: one that defines the “events” and exposes a method to register “handlers”, and the other mandates the presence of a callback for each “event”. For INotifyPropertyChange the handler interface was named IHandlePropertyChange, so I went with IControlEvents and IHandleControlEvents.

So, the “provider” interface looks like this:

'@Folder MVVM.Infrastructure.Bindings.Abstract
'@ModuleDescription "Provides the infrastructure to relay MSForms.Control events."
Option Explicit
Public Sub RegisterHandler(ByVal Handler As IHandleControlEvents)
End Sub
Public Sub OnEnter()
End Sub
Public Sub OnExit(ByVal Cancel As MSForms.ReturnBoolean)
End Sub
Public Sub OnAfterUpdate()
End Sub
Public Sub OnBeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
End Sub

And then the “handler” interface looks like this:

'@Folder MVVM.Infrastructure.Bindings.Abstract
'@ModuleDescription "An object that can be registered as a handler for IControlEvents callbacks."
Option Explicit
Public Sub HandleEnter()
End Sub
Public Sub HandleExit(ByVal Cancel As MSForms.ReturnBoolean)
End Sub
Public Sub HandleAfterUpdate()
End Sub
Public Sub HandleBeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
End Sub

So, looking back at the ControlEventsPunk class, we find that the implementation for RegisterHandler consists in adding the provided Handler object to an encapsulated Collection that holds all the registered handlers; when we “handle” a control event, we iterate all registered handlers and invoke them all in a sequence. When an event has a Cancel parameter, the last handler that ran gets the final say on whether the parameter should be True or False, and each handler receives the Cancel value that was set by the previous handler than ran.

This is a slightly different paradigm than your regular VBA/VB6 auto-wired events, where one event only ever has one handler: now these work more like the multicast delegates that events are in .NET, with an “invocation list” and the ability to add/remove (although, I haven’t implemented the removal) handlers dynamically at run-time – except the “handlers” are full-fledged VBA objects here, rather than .NET delegates.

Whenever the MVVM infrastructure needs to propagate events, I use this pattern instead. This was my first time actually implementing an Observer Pattern, and hadn’t even realized! (thanks Max!) – that isn’t a pattern you see often in event-capable languages, but I can definitely see this proven, solid abstraction (Java developers would probably be rather familiar with that one) become my new favorite go-to pattern to expose events on an interface in VBA… But there’s probably a reason the first time I come across a situation where that pattern is really handy (and actually needed, for testability), is when I’m writing framework-level (i.e. an API intended to be used by code that isn’t written yet) code that’s very much as deep into the OOP rabbit hole as I’ve ever been in VBA (or any other language for that matter)… and there’s still no rock bottom in sight.

In any case, now that we have a way to handle and propagate control events, we can have MVVM property bindings that can format TextBox.Text on exit, i.e. we can have a ViewModel that knows SomeProperty has a value of 25.59, and the Text property of the bound textbox control can say $25.59 just by specifying a FormatString (like “Currency”, for example) when we create the binding.

For the next post in this series I think we’re ready to deep-dive into the actual binding mechanics, and I’ll have the updated MVVM infrastructure code on GitHub by then.

Making MVVM Work in VBA Part 1 – Testing

I have recently written (100% VBA) a proof-of-concept for a Model-View-ViewModel (MVVM) framework, and since the prototype works exactly as needed (with some rough edges of course)… I’ve decided to explore what Rubberduck can do to make MVVM fully supported, but going down that path poses a serious problem that needs a very good and well thought-out solution.

A Vision of a Framework

When you start a new project in Visual Studio (including 6.0 /VB6), the IDE prompts for a project type, essentially asking “what are we building today?

In VBA the assumption is that you just want to write a bit of script to automate some document manipulation. And then the framework so to speak, is the VBA Standard Library: functions, methods, constants, and actual objects too; all globally-scoped for convenience and quick-and-easy access: a fully spelled-out VBA.Interaction.MsgBox function call is a rare sight! Combined with the nonexistence of namespaces, the flip side is that the global scope is easily polluted, and name collisions are inevitable since anything exposed by any library becomes globally accessible. This makes fully-qualified global function calls appear sporadically sprinkled in the code, which can be confusing. I digress, but what I mean to get at is that this is part of what made Microsoft make the shift to the .NET platform in the early 2000’s, and eventually abandon the Visual Basic Editor to its fate. The COM platform and Win32 API was the framework, and Win32 programming languages built on top of that.

This leaves two approaches for a vision of a “framework” for VBA:

  • Package a type library and ship it.
    • Pros: any COM-visible library will work, can be written in .NET
    • Cons: projects now have a hard dependency on a specific type library; updating is a mess, etc.
  • Embed the framework into VBA projects, pretty much like JavaScript does.
    • Pros: devs are in charge of everything, framework is 100% VBA and inherently open-source, updating is essentially seamless for any non-breaking change, no early-bound dependencies, graceful late-bound degradation, etc.
    • Cons: VBA devs and maintainers that aren’t using Rubberduck will be massively lost in the source code (framework would cleanly leverage @Folder annotations), but then when the host application allows it this could be mitigated by embedding the code into its own separate VBA project and reference it from other projects (e.g. ship an Excel add-in with the framework code your VBA project depends on).

I think I’m slightly biased here, but I think this rules out the type library approach regardless. So we need a way to make this work in VBA, with VBA source code that lives in a GitHub repository with vetted, trusted content.

Where Rubberduck fits in

Like Visual Studio, Rubberduck could prompt VBA devs with “what are we building today?” and offer to pull various “bundles” of modules from this GitHub repository into the active project. Rubberduck would request the available “bundles” from api.rubberduckvba.com, which would return with “bundle metadata” describing each “package” (is “nugget” forbidden to use as a name for these / play on “nuget” (the package manager for .NET)?), and then list them in a nice little dialog.

The “nugget” metadata would include a name, a description, and the path to each file to download for it. Every package would be the same “version”, but the tool could easily request any particular “tag” or “release” version, and/or pull from “main” or from “next” branches, and the source code / framework itself could then easily be a collaborative effort, with its own features and projects and milestones and collaborators, completely separate from the C# Rubberduck code base.

This complete decoupling from Rubberduck means you don’t need to use Rubberduck to leverage this VBA code in your VBA projects, and new tags / “releases” would be entirely independent of Rubberduck’s own release cycles. That means you’re using, say, future-Rubberduck 2.7.4 and the “nuggets” feature offers “v1.0 [main]” and “v1.1 [next]”; one day you’re still using Rubberduck 2.7.4 but now you get “v1.1 [main]”, “v1.0”, and “v1.2 [next]” to chose from, and if you updated the “nuggets” in your project from v1.0 to v1.1 then Rubberduck inspections would flag uses of any obsolete members that would now be decorated with @Obsolete annotations… it’s almost like this annotation was presciently made for this.

But before we can even think of implementing something like this and make MVVM infrastructure the very first “nugget”, we need a rock-solid framework in the first place.


Unit Tests

I had already written the prototype in a highly decoupled manner, mindful of dependencies and how things could later be tested from the outside. I’m very much not-a-zealot when it comes to things like Test-Driven Development (TDD), but I do firmly believe unit tests provide a solid safety net and documentation for everything that matters – especially if the project is to make any kind of framework, where things need to provably work.

And then it makes a wonderful opportunity to blog about writing unit tests with Rubberduck, something I really haven’t written nearly enough about.

Tests? Why?!

Just by writing these tests, I’ve found and fixed edge-case bugs and improved decoupling and cohesion by extracting (and naming!) smaller chunks of functionality into their own separate class module. The result is quite objectively better, simpler code.

Last but not least, writing testable code (let alone the tests!) in VBA makes a great way to learn these more advanced notions and concepts in a language you’re already familiar with.

If you’re new to VBA and programming in general, or if you’re not a programmer and you’re only interested in making macros, then reading any further may make your head spin a bit (if that’s already under way… I’m sorry!), so don’t hesitate to ask here or on the examples repository on GitHub if you have any questions! This article is covering a rather advanced topic, beyond classes and interfaces, but keep in mind that unit testing does not require OOP! It just so happens that object-oriented code adhering to SOLID principles tends to be easily testable.

This is an ongoing project and I’m still working on the test suite and refactoring things; I wouldn’t want to upload the code to GitHub in its current shape, so I’ll come back here with a link once I have something that’s relatively complete.


Where to Start?

There’s a relatively small but very critical piece of functionality that makes a good place to begin in the MVVM infrastructure code (see previous article): the BindingPath class, which I’ve pulled out of PropertyBinding this week. The (still too large for its own good) PropertyBinding class is no longer concerned with the intricacies of resolving property names and values: both this.Source and this.Target are declared As IBindingPath in a PropertyBinding now, which feels exactly right.

The purpose of a BindingPath is to take a “binding context” object and a “binding path” string (the binding path is always relative to the binding context), and to resolve the member call represented there. For example, this would be a valid use of the class:

Dim Path As IBindingPath
Set Path = BindingPath.Create(Sheet1.Shapes("Shape1").TextFrame.Characters, "Text")

This Path object implements TryReadPropertyValue and TryWritePropertyValue methods that the BindingManager can invoke as needed.

'@Folder MVVM.Infrastructure.Bindings
'@ModuleDescription "An object that can resolve a string property path to a value."
'@PredeclaredId
Option Explicit
Implements IBindingPath
Private Type TState
    Context As Object
    Path As String
    
    Object As Object
    PropertyName As String
End Type
Private This As TState
'@Description "Creates a new binding path from the specified property path string and binding context."
Public Function Create(ByVal Context As Object, ByVal Path As String) As IBindingPath
    GuardClauses.GuardNonDefaultInstance Me, BindingPath, TypeName(Me)
    GuardClauses.GuardNullReference Context, TypeName(Me)
    GuardClauses.GuardEmptyString Path, TypeName(Me)
    
    Dim Result As BindingPath
    Set Result = New BindingPath
    Set Result.Context = Context
    Result.Path = Path
    
    Result.Resolve
    Set Create = Result
End Function
'@Description "Gets/Sets the binding context."
Public Property Get Context() As Object
    Set Context = This.Context
End Property
Public Property Set Context(ByVal RHS As Object)
    GuardClauses.GuardDefaultInstance Me, BindingPath, TypeName(Me)
    GuardClauses.GuardNullReference RHS, TypeName(Me)
    GuardClauses.GuardDoubleInitialization This.Context, TypeName(Me)
    Set This.Context = RHS
End Property
'@Description "Gets/Sets a string representing a property path against the binding context."
Public Property Get Path() As String
    Path = This.Path
End Property
Public Property Let Path(ByVal RHS As String)
    GuardClauses.GuardDefaultInstance Me, BindingPath, TypeName(Me)
    GuardClauses.GuardEmptyString RHS, TypeName(Me)
    GuardClauses.GuardDoubleInitialization This.Path, TypeName(Me)
    This.Path = RHS
End Property
'@Description "Gets the bound object reference."
Public Property Get Object() As Object
    Set Object = This.Object
End Property
'@Description "Gets the name of the bound property."
Public Property Get PropertyName() As String
    PropertyName = This.PropertyName
End Property
'@Description "Resolves the Path to a bound object and property."
Public Sub Resolve()
    This.PropertyName = ResolvePropertyName(This.Path)
    Set This.Object = ResolvePropertyPath(This.Context, This.Path)
End Sub
Private Function ResolvePropertyName(ByVal PropertyPath As String) As String
    Dim Parts As Variant
    Parts = Strings.Split(PropertyPath, ".")
    ResolvePropertyName = Parts(UBound(Parts))
End Function
Private Function ResolvePropertyPath(ByVal Context As Object, ByVal PropertyPath As String) As Object
    Dim Parts As Variant
    Parts = Strings.Split(PropertyPath, ".")
    
    If UBound(Parts) = LBound(Parts) Then
        Set ResolvePropertyPath = Context
    Else
        Dim RecursiveProperty As Object
        Set RecursiveProperty = CallByName(Context, Parts(0), VbGet)
        If RecursiveProperty Is Nothing Then Exit Function
        Set ResolvePropertyPath = ResolvePropertyPath(RecursiveProperty, Right$(PropertyPath, Len(PropertyPath) - Len(Parts(0)) - 1))
    End If
    
End Function
Private Property Get IBindingPath_Context() As Object
    Set IBindingPath_Context = This.Context
End Property
Private Property Get IBindingPath_Path() As String
    IBindingPath_Path = This.Path
End Property
Private Property Get IBindingPath_Object() As Object
    Set IBindingPath_Object = This.Object
End Property
Private Property Get IBindingPath_PropertyName() As String
    IBindingPath_PropertyName = This.PropertyName
End Property
Private Sub IBindingPath_Resolve()
    Resolve
End Sub
Private Function IBindingPath_ToString() As String
    IBindingPath_ToString = StringBuilder _
        .AppendFormat("Context: {0}; Path: {1}", TypeName(This.Context), This.Path) _
        .ToString
End Function
Private Function IBindingPath_TryReadPropertyValue(ByRef outValue As Variant) As Boolean
    If This.Object Is Nothing Then Resolve
    On Error Resume Next
    outValue = VBA.Interaction.CallByName(This.Object, This.PropertyName, VbGet)
    IBindingPath_TryReadPropertyValue = (Err.Number = 0)
    On Error GoTo 0
End Function
Private Function IBindingPath_TryWritePropertyValue(ByVal Value As Variant) As Boolean
    If This.Object Is Nothing Then Resolve
    On Error Resume Next
    VBA.Interaction.CallByName This.Object, This.PropertyName, VbLet, Value
    IBindingPath_TryWritePropertyValue = (Err.Number = 0)
    On Error GoTo 0
End Function

Here’s our complete “system under test” (SUT) as far as the BindingPathTests module goes. We have a Create factory method, Context and Path properties, just like the class we’re testing.

The path object is itself read-only once initialized, but the binding source may resolve to Nothing or to a different object reference over the course of the object’s lifetime: say we want a binding path to SomeViewModel.SomeObjectProperty; when we first create the binding, SomeObjectProperty might very well be Nothing, and then it’s later Set-assigned to a valid object reference. This is why the IBindingPath interface needs to expose a Resolve method, so that IPropertyBinding can invoke it as needed, as the binding is being applied.

We’ll want a test for every guard clause, and each method needs at least one test as well.

So, I’m going to add a new test module and call it BindingPathTests. Rubberduck’s templates are good-enough to depict the mechanics and how things work at a high level, but if you stick to the templates you’ll quickly find your unit tests rather boring, wordy, and repetitive: we must break out of the mold, there isn’t one true way to do this!

Rubberduck discovers unit tests in standard modules annotated with @TestModule. Test methods are any [parameterless, for now] method annotated with a @TestMethod annotation that can have a category string – the Test Explorer can group your tests using these categories. The declarations section of a test module must include a declaration (early or late bound) for an Rubberduck.AssertClass or Rubberduck.PermissiveAssertClass (both implement the same internal interface; the “permissive” one has VBA-like equality semantics, and the default one has stricter type equality requirements (a Long can’t be equal to a Double, for example). The default test template also defines a FakesProvider object, but we’re not going to need it now (if we needed to test logic that involved e.g. branching on the result of a MsgBox function call, we could hook into the MsgBox function and configure it to return what the test needs it to return, which is honestly wicked awesome). So our test module might look something like this at first:

'@Folder Tests.Bindings
'@TestModule
Option Explicit
Option Private Module
#Const LateBind = LateBindTests
#If LateBind Then
Private Assert As Object
#Else
Private Assert As Rubberduck.AssertClass
#End If

With this conditionally-compiled setup, all we need to toggle between late and early binding is to define a project-scoped conditional compilation argument: bring up the project properties and type LateBindTests=0 or LateBindTests=1 in that box, and just like that you can control conditional compilation project-wide without modifying a single module.

The first thing to do is to get the test state defined, and implement TestInitialize and TestCleanup methods that configure this state – in the case of BindingManagerTests, I’m going to add a private type and a private field to define and hold the current test state:

Private Type TState
    ExpectedErrNumber As Long
    ExpectedErrSource As String
    ExpectedErrorCaught As Boolean
    
    ConcreteSUT As BindingManager
    AbstractSUT As IBindingManager
    HandlePropertyChangedSUT As IHandlePropertyChanged
    
    BindingSource As TestBindingObject
    BindingTarget As TestBindingObject
    SourcePropertyPath As String
    TargetPropertyPath As String
    Command As TestCommand
End Type
Private Test As TState

Unit Testing Paradigm

Test modules are special, in the sense that they aren’t (absolutely shouldn’t be anyway) accessible from any code path in the project. Rubberduck invokes them one by one when you run a command like “run all tests” or “repeat last run”. But there’s a little more to it than that, worthy of mention.

VBA being single-threaded, tests are invoked by Rubberduck on the UI/main thread, and uses a bit of trickery to keep its own UI somewhat responsive. Each module runs sequentially, and each test inside each module runs sequentially as well – but the test execution order still shouldn’t be considered deterministic, and each test should be completely independent of every other test, such that executing all tests in any given order always produces the same outcomes.

A test that makes no assertions will be green/successful. When writing unit tests, the first thing you want to see is a test that’s failing (you can’t trust a test you have never seen fail!), and with Rubberduck in order to give a test a reason to fail, you use Assert methods (wiki).

When Rubberduck begins processing a test module, it invokes the methods (again, sequentially but not in an order that should matter) marked @ModuleInitialize in the module – ideally that would be only one method.

This is where the Assert object should be assigned (the default test templates do this):

'@ModuleInitialize
Private Sub ModuleInitialize()
#If LateBind Then
    'requires HKCU registration of the Rubberduck COM library.
    Set Assert = CreateObject("Rubberduck.PermissiveAssertClass")
#Else
    'requires project reference to the Rubberduck COM library.
    Set Assert = New Rubberduck.PermissiveAssertClass
#End If
End Sub

Rubberduck’s test engine will then execute all methods (usually cleaner with only one though) annotated with @TestInitialize before executing each test in the module; that is the best place to put the wordy setup code that would otherwise need to be in pretty much every single test of the module:

'@TestInitialize
Private Sub TestInitialize()
    Dim Context As TestBindingObject
    Set Context = New TestBindingObject
    
    Set Context.TestBindingObjectProperty = New TestBindingObject
    
    Test.Path = "TestBindingObjectProperty.TestStringProperty"
    Test.PropertyName = "TestStringProperty"
    Set Test.BindingSource = Context.TestBindingObjectProperty
    
    Set Test.BindingContext = Context
    Set Test.ConcreteSUT = BindingPath.Create(Test.BindingContext, Test.Path)
    Set Test.AbstractSUT = Test.ConcreteSUT
End Sub

By moving the test state to module level rather than having it local to each test, we already eliminate a lot of code duplication, and the Test module variable makes a rather nifty way to access the current test state, too!

Methods annotated with @TestCleanup are automatically invoked after each test in the module; in order to avoid accidentally sharing state between tests, every object reference should be explicitly set to Nothing, and values of intrinsic data types should be explicitly reset to their respective default value:

'@TestCleanup
Private Sub TestCleanup()
    Set Test.ConcreteSUT = Nothing
    Set Test.AbstractSUT = Nothing
    Set Test.BindingSource = Nothing
    Set Test.BindingContext = Nothing
    Test.Path = vbNullString
    Test.PropertyName = vbNullString
    Test.ExpectedErrNumber = 0
    Test.ExpectedErrSource = vbNullString
    Test.ExpectedErrorCaught = False
End Sub

What Goes Into the Test State?

A number of members should always be in the Test state structure:

  • ConcreteSUT (or just SUT) and AbstractSUT both point to the same object, through the default interface (BindingPath) and the explicit one (IBindingPath), respectively.
  • If the system under test class implements additional interfaces, having a pointer to the SUT object with these interfaces is also useful. For example the TState type for the BindingManager class has a HandlePropertyChangedSUT As IHandlePropertyChanged member, because the class implements this interface.
  • Default property values and dependency setup: we want a basic default SUT configured and ready to be tested (or fine-tuned and then tested).
  • ExpectedErrNumber, ExpectedErrSource, and ExpectedErrorCaught are useful when a test is expecting a given input to produce a particular specific error.

Expecting Errors

The “expected error” test method template works for its purpose, but having this on-error-assert logic duplicated everywhere is rather ugly. Consider pulling that logic into a private method instead (I’m considering adding this into Rubberduck’s test module templates):

Private Sub ExpectError()
    Dim Message As String
    If Err.Number = Test.ExpectedErrNumber Then
        If (Test.ExpectedErrSource = vbNullString) Or (Err.Source = Test.ExpectedErrSource) Then
            Test.ExpectedErrorCaught = True
        Else
            Message = "An error was raised, but not from the expected source. " & _
                      "Expected: '" & TypeName(Test.ConcreteSUT) & "'; Actual: '" & Err.Source & "'."
        End If
    ElseIf Err.Number <> 0 Then
        Message = "An error was raised, but not with the expected number. Expected: '" & Test.ExpectedErrNumber & "'; Actual: '" & Err.Number & "'."
    Else
        Message = "No error was raised."
    End If
    
    If Not Test.ExpectedErrorCaught Then Assert.Fail Message
End Sub

With this infrastructure in place, the unit tests for all guard clauses in the module can look like this – it’s still effectively doing Arrange-Act-Assert like the test method templates strongly suggest, only implicitly so (each “A” is essentially its own statement, see comments in the tests below):

'@TestMethod("GuardClauses")
Private Sub Create_GuardsNullBindingContext()
    Test.ExpectedErrNumber = GuardClauseErrors.ObjectCannotBeNothing '<~ Arrange
    On Error Resume Next
        BindingPath.Create Nothing, Test.Path '<~ Act
        ExpectError '<~ Assert
    On Error GoTo 0
End Sub
'@TestMethod("GuardClauses")
Private Sub Create_GuardsEmptyPath()
    Test.ExpectedErrNumber = GuardClauseErrors.StringCannotBeEmpty '<~ Arrange
    On Error Resume Next
        BindingPath.Create Test.BindingContext, vbNullString '<~ Act
        ExpectError '<~ Assert
    On Error GoTo 0
End Sub
'@TestMethod("GuardClauses")
Private Sub Create_GuardsNonDefaultInstance()
    Test.ExpectedErrNumber = GuardClauseErrors.InvalidFromNonDefaultInstance '<~ Arrange
    On Error Resume Next
        With New BindingPath
            .Create Test.BindingContext, Test.Path '<~ Act
            ExpectError '<~ Assert
        End With
    On Error GoTo 0
End Sub

And then similar tests exist for the respective guard clauses of Context and Path members. Having tests that validate that guard clauses are doing their job is great: it tells us exactly how not to use the class… and that doesn’t tell us much about what a BindingPath object actually does.


Testing the Actual Functionality

The methods we’re testing need to be written in a way that makes it possible for a test to determine whether it’s doing its job correctly or not. For functions and properties, the return value is the perfect thing to Assert on. For Sub procedures, you have to Assert on the side-effects, and have verifiable and useful, reliable ways to verify them.

These two tests validate that the BindingPath returned by the Create factory method has resolved the PropertyName and Object properties, respectively.

'@TestMethod("Bindings")
Private Sub Create_ResolvesPropertyName()
    Dim SUT As BindingPath
    Set SUT = BindingPath.Create(Test.BindingContext, Test.Path)
    Assert.IsFalse SUT.PropertyName = vbNullString
End Sub
'@TestMethod("Bindings")
Private Sub Create_ResolvesBindingSource()
    Dim SUT As BindingPath
    Set SUT = BindingPath.Create(Test.BindingContext, Test.Path)
    Assert.IsNotNothing SUT.Object
End Sub

I could have made multiple assertions in a test, like this…

'@TestMethod("Bindings")
Private Sub Create_ResolvesBindingSource()
    Dim SUT As BindingPath
    Set SUT = BindingPath.Create(Test.BindingContext, Test.Path)
    Assert.IsFalse SUT.PropertyName = vbNullString
    Assert.IsNotNothing SUT.Object
End Sub

The Test Explorer would say “IsFalse assert failed” or “IsNotNothing assert failed”, so it’s arguably (perhaps pragmatically so) still useful and clear enough why that test would fail (and if you had multiple Assert.IsFalse calls in a test you could provide a different message for each)… but really as a rule of thumb, tests want to have one reason to fail. If the conditions to meaningfully pass or fail a test aren’t present, use Assert.Inconclusive to report the test as such:

'@TestMethod("Bindings")
Private Sub Resolve_SetsBindingSource()
    With New BindingPath
        .Path = Test.Path
        Set .Context = Test.BindingContext
        
        If Not .Object Is Nothing Then Assert.Inconclusive "Object reference is unexpectedly set."
        .Resolve
        
        Assert.AreSame Test.BindingSource, .Object
    End With
End Sub
'@TestMethod("Bindings")
Private Sub Resolve_SetsBindingPropertyName()
    With New BindingPath
        .Path = Test.Path
        Set .Context = Test.BindingContext
        
        If .PropertyName <> vbNullString Then Assert.Inconclusive "PropertyName is unexpectedly non-empty."
        .Resolve
        
        Assert.AreEqual Test.PropertyName, .PropertyName
    End With
End Sub

This mechanism is especially useful when the test state isn’t in local scope and there’s a real possibility that the TestInitialize method is eventually modified and inadvertently breaks a test. Such conditional Assert.Inconclusive calls are definitely a form of defensive programming, just like having guard clauses throwing custom meaningful errors.

Note that while we know that the BindingPath.Create function invokes the Resolve method, the tests for Resolve don’t involve Create: the Path and Context are being explicitly spelled out, and the .Resolve method is invoked from a New instance.

And that’s pretty much everything there is to test in the BindingPath class.

There’s one thing I haven’t mentioned yet, that you might have caught in the TState type:

BindingSource As TestBindingObject
BindingTarget As TestBindingObject

This TestBindingObject is a test stub: it’s a dependency of the class (it’s the “binding context” of the test path) and it’s a real object, but it is implemented in a bit of a special way that the BindingPath tests don’t do justice to.

Test Stubs

Eventually Rubberduck’s unit testing framework will feature a COM-visible wrapper around Moq, a popular mocking framework for .NET that Rubberduck already uses for its own unit test requirements. When this happens Rubberduck unit tests will no longer need such “test stubs”. Instead, the framework will generate them at run-time and make them work exactly as specified/configured by a unit test, and “just like that” VBA/VB6 suddenly becomes surprisingly close to being pretty much on par with professional, current-day IDE tooling.

The ITestStub interface simply formalizes the concept:

'@Exposed
'@Folder Tests.Stubs
'@ModuleDescription "An object that stubs an interface for testing purposes."
'@Interface
Option Explicit
'@Description "Gets the number of times the specified member was invoked in the lifetime of the object."
Public Property Get MemberInvokes(ByVal MemberName As String) As Long
End Property
'@Description "Gets a string representation of the object's internal state, for debugging purposes (not intended for asserts!)."
Public Function ToString() As String
End Function

A TestStubBase “base class” provides the common implementation mechanics that every class implementing ITestStub will want to use – the idea is to use a keyed data structure to track the number of times each member is invoked during the lifetime of the object:

'@Folder Tests.Stubs
Option Explicit
Private Type TState
    MemberInvokes As Dictionary
End Type
Private This As TState
'@Description "Tracks a new invoke of the specified member."
Public Sub OnInvoke(ByVal MemberName As String)
    Dim newValue As Long
    If This.MemberInvokes.Exists(MemberName) Then
        newValue = This.MemberInvokes.Item(MemberName) + 1
        This.MemberInvokes.Remove MemberName
    Else
        newValue = 1
    End If
    This.MemberInvokes.Add MemberName, newValue
End Sub
'@Description "Gets the number of invokes made against the specified member in the lifetime of this object."
Public Property Get MemberInvokes(ByVal MemberName As String) As Long
    If This.MemberInvokes.Exists(MemberName) Then
        MemberInvokes = This.MemberInvokes.Item(MemberName)
    Else
        MemberInvokes = 0
    End If
End Property
'@Description "Gets a string listing the MemberInvokes cache content."
Public Function ToString() As String
    Dim MemberNames As Variant
    MemberNames = This.MemberInvokes.Keys
    
    With New StringBuilder
        Dim i As Long
        For i = LBound(MemberNames) To UBound(MemberNames)
            Dim Name As String
            Name = MemberNames(i)
            .AppendFormat "{0} was invoked {1} time(s)", Name, This.MemberInvokes.Item(Name)
        Next
        ToString = .ToString
    End With
    
End Function
Private Sub Class_Initialize()
    Set This.MemberInvokes = New Dictionary
End Sub

With this small bit of infrastructure, the TestBindingObject class is a full-fledged mock object that can increment a counter whenever a member is invoked, and that can be injected as a dependency for anything that needs an IViewModel:

'@Folder Tests.Stubs
'@ModuleDescription "An object that can stub a binding source or target for unit tests."
Option Explicit
Implements ITestStub
Implements IViewModel
Implements INotifyPropertyChanged
Private Type TState
    Stub As TestStubBase
    Handlers As Collection
    TestStringProperty As String
    TestNumericProperty As Long
    TestBindingObjectProperty As TestBindingObject
    Validation As IHandleValidationError
End Type
Private This As TState
Public Property Get TestStringProperty() As String
    This.Stub.OnInvoke "TestStringProperty.Get"
    TestStringProperty = This.TestStringProperty
End Property
Public Property Let TestStringProperty(ByVal RHS As String)
    This.Stub.OnInvoke "TestStringProperty.Let"
    If This.TestStringProperty <> RHS Then
        This.TestStringProperty = RHS
        OnPropertyChanged Me, "TestStringProperty"
    End If
End Property
Public Property Get TestNumericProperty() As Long
    This.Stub.OnInvoke "TestNumericProperty.Get"
    TestNumericProperty = This.TestNumericProperty
End Property
Public Property Let TestNumericProperty(ByVal RHS As Long)
    This.Stub.OnInvoke "TestNumericProperty.Let"
    If This.TestNumericProperty <> RHS Then
        This.TestNumericProperty = RHS
        OnPropertyChanged Me, "TestNumericProperty"
    End If
End Property
Public Property Get TestBindingObjectProperty() As TestBindingObject
    This.Stub.OnInvoke "TestBindingObjectProperty.Get"
    Set TestBindingObjectProperty = This.TestBindingObjectProperty
End Property
Public Property Set TestBindingObjectProperty(ByVal RHS As TestBindingObject)
    This.Stub.OnInvoke "TestBindingObjectProperty.Set"
    If Not This.TestBindingObjectProperty Is RHS Then
        Set This.TestBindingObjectProperty = RHS
        OnPropertyChanged Me, "TestBindingObjectProperty"
    End If
End Property
Private Sub OnPropertyChanged(ByVal Source As Object, ByVal PropertyName As String)
    Dim Handler As IHandlePropertyChanged
    For Each Handler In This.Handlers
        Handler.OnPropertyChanged Source, PropertyName
    Next
End Sub
Private Sub Class_Initialize()
    Set This.Stub = New TestStubBase
    Set This.Handlers = New Collection
    Set This.Validation = ValidationManager.Create
End Sub
Private Sub INotifyPropertyChanged_OnPropertyChanged(ByVal Source As Object, ByVal PropertyName As String)
    OnPropertyChanged Source, PropertyName
End Sub
Private Sub INotifyPropertyChanged_RegisterHandler(ByVal Handler As IHandlePropertyChanged)
    This.Handlers.Add Handler
End Sub
Private Property Get ITestStub_MemberInvokes(ByVal MemberName As String) As Long
    ITestStub_MemberInvokes = This.Stub.MemberInvokes(MemberName)
End Property
Private Function ITestStub_ToString() As String
    ITestStub_ToString = This.Stub.ToString
End Function
Private Property Get IViewModel_Validation() As IHandleValidationError
    Set IViewModel_Validation = This.Validation
End Property

This functionality will be extremely useful when testing the actual property bindings: for example we can assert that a method was invoked exactly once, and fail a test if the method was invoked twice (and/or if it never was).


There’s a lot more to discuss about unit testing in VBA with Rubberduck! I hope this article gives a good idea of how to get the best out of Rubberduck’s unit testing feature.

Model, View, ViewModel

100% VBA, 100% OOP

We’ve seen in UserForm1.Show what makes a Smart UI solution brittle, and how to separate the UI concerns from rest of the logic with the Model-View-Presenter (MVP) UI pattern. MVP works nicely with the MSForms library (UserForms in VBA), just like it does with its .NET Windows Forms successor. While the pattern does a good job of enhancing the testability of application logic, it also comes with its drawbacks: the View’s code-behind (that is, the code module “behind” the form designer) is still littered with noisy event handlers and boilerplate code, and the back-and-forth communication between the View and the Presenter feels somewhat clunky with events and event handlers.

Rubberduck’s UI elements are made with the Windows Presentation Foundation (WPF) UI framework, which completely redefines how everything about UI programming works, starting with the XML/markup-based (XAML) design, but the single most compelling element is just how awesome its data binding capabilities are.

We can leverage in VBA what makes Model-View-ViewModel (MVVM) awesome in C# without going nuts and writing a whole UI framework from scratch, but we’re still going to need a bit of an abstract infrastructure to work with. It took the will to do it and only costed a hair or two, but as far as I can tell this works perfectly fine, at least at the proof-of-concept stage.

This article is the first in a series that revolves around MVVM in VBA as I work (very much part-time) on the rubberduckdb content admin tool. There’s quite a bit of code to make this magic happen, so let’s kick this off with what it does and how to use it – subsequent articles will dive into how the MVVM infrastructure internals work. As usual the accompanying code can be found in the examples repository on GitHub (give it a star, and fork it, then make pull requests with your contributions during Hacktoberfest next month and you can get a t-shirt, stickers, and other free stuff, courtesy of Digital Ocean!).

Overview

The code in the examples repository isn’t the reason I wrote this: I mentioned in the previous post that I was working on an application to maintain the website content, and decided to explore the Model-View-ViewModel pattern for that one. Truth be told, MVVM is hands-down my favorite UI pattern, by far. This is simply the cleanest UI code I’ve ever written in VBA, and I love it!

A screenshot of a carefully-crafted dialog form for managing content served by rubberduckvba.com. A modal prompts the user for SQL Server credentials, all commands but the "reload" button are disabled.
The app is work in progress, but the property and command bindings work!

The result is an extremely decoupled, very extensible, completely testable architecture where every user action (“command”) is formally defined, can be programmatically simulated/tested with real, stubbed, or faked dependencies, and can be bound to multiple UI elements and programmatically executed as needed.

MVVM Quick Checklist

These would be the rules to follow as far a relationships go between the components of the MVVM pattern:

  • View (i.e. the UserForm) knows about the ViewModel, but not the Model;
  • ViewModel knows about commands, but nothing about a View;
  • Exactly what the Model actually is/isn’t/should/shouldn’t be, is honestly not a debate I’m interested in – I’ll just call whatever set of classes is responsible for hydrating my ViewModel with data my “model” and sleep at night. What matters is that whatever you call the Model knows nothing of a View or ViewModel, it exists on its own.

Before we dive into bindings and the infrastructure code, we need to talk about the command pattern.

Commands

A command is an object that implements an ICommand interface that might look like this:

'@Folder MVVM.Infrastructure
'@ModuleDescription "An object that represents an executable command."
'@Interface
'@Exposed
Option Explicit

'@Description "Returns True if the command is enabled given the provided binding context (ViewModel)."
Public Function CanExecute(ByVal Context As Object) As Boolean
End Function

'@Description "Executes the command given the provided binding context (ViewModel)."
Public Sub Execute(ByVal Context As Object)
End Sub

'@Description "Gets a user-friendly description of the command."
Public Property Get Description() As String
End Property

In the case of a CommandBinding the Context parameter is always the DataContext / ViewModel (for now anyway), but manual invokes could supply other kinds of parameters. Not all implementations need to account for the ViewModel, a CanExecute function that simply returns True is often perfectly fine. The Description is used to set a tooltip on the target UI element of the command binding.

The implementation of a command can be very simple or very complex, depending on the needs. A command might have one or more dependencies, for example a ReloadCommand might want to be injected with some IDbContext object that exposes a SelectAllTheThings function and the implementation might pull them from a database, or make them up from hard-coded strings: the command has no business knowing where the data comes from and how it’s acquired.

Each command is its own class, and encapsulates the logic for enabling/disabling its associated control and executing the command. This leaves the UserForm module completely devoid of any logic that isn’t purely a presentation concern – although a lot can be achieved solely with property bindings and validation error formatters.

The infrastructure code comes with AcceptCommand and CancelCommand implementations, both useful to wire up [Ok], [Cancel], or [Close] dialog buttons.

AcceptCommand

The AcceptCommand can be used as-is for any View that can be closed with a command involving similar semantics. It is implemented as follows:

'@Exposed
'@Folder MVVM.Infrastructure.Commands
'@ModuleDescription "A command that closes (hides) a View."
'@PredeclaredId
Option Explicit
Implements ICommand

Private Type TState
    View As IView
End Type

Private this As TState

'@Description "Creates a new instance of this command."
Public Function Create(ByVal View As IView) As ICommand
    Dim result As AcceptCommand
    Set result = New AcceptCommand
    Set result.View = View
    Set Create = result
End Function

Public Property Get View() As IView
    Set View = this.View
End Property

Public Property Set View(ByVal RHS As IView)
    GuardClauses.GuardDoubleInitialization this.View, TypeName(Me)
    Set this.View = RHS
End Property

Private Function ICommand_CanExecute(ByVal Context As Object) As Boolean
    Dim ViewModel As IViewModel
    If TypeOf Context Is IViewModel Then
        Set ViewModel = Context
        If Not ViewModel.Validation Is Nothing Then
            ICommand_CanExecute = ViewModel.Validation.IsValid
            Exit Function
        End If
    End If
    ICommand_CanExecute = True
End Function

Private Property Get ICommand_Description() As String
    ICommand_Description = "Accept changes and close."
End Property

Private Sub ICommand_Execute(ByVal Context As Object)
    this.View.Hide
End Sub

CancelCommand

This command is similar to the AcceptCommand in that it simply invokes a method in the View. This implementation could easily be enhanced by making the ViewModel track “dirty” (modified) state and prompting the user when they are about to discard unsaved changes.

'@Folder MVVM.Infrastructure.Commands
'@ModuleDescription "A command that closes (hides) a cancellable View in a cancelled state."
'@PredeclaredId
'@Exposed
Option Explicit
Implements ICommand

Private Type TState
    View As ICancellable
End Type

Private this As TState

'@Description "Creates a new instance of this command."
Public Function Create(ByVal View As ICancellable) As ICommand
    Dim result As CancelCommand
    Set result = New CancelCommand
    Set result.View = View
    Set Create = result
End Function

Public Property Get View() As ICancellable
    Set View = this.View
End Property

Public Property Set View(ByVal RHS As ICancellable)
    GuardClauses.GuardDoubleInitialization this.View, TypeName(Me)
    Set this.View = RHS
End Property

Private Function ICommand_CanExecute(ByVal Context As Object) As Boolean
    ICommand_CanExecute = True
End Function

Private Property Get ICommand_Description() As String
    ICommand_Description = "Cancel pending changes and close."
End Property

Private Sub ICommand_Execute(ByVal Context As Object)
    this.View.OnCancel
End Sub

This gives us very good indications about how the pattern wants user actions to be implemented:

  • Class can have a @PredeclaredId annotation and expose a factory method to property-inject any dependencies; here a IView object, but a custom SaveChangesCommand would likely get injected with some DbContext service class.
  • All commands need a description; that description is user-facing as a tooltip on the binding target (usually a CommandButton).
  • CanExecute can be as simple as an unconditional ICommand_CanExecute = True, or as complex as needed (it has access to the ViewModel context); keep in mind that this method can be invoked relatively often, and should perform well and return quickly.

It’s a simple interface with a simple purpose: attach a command to a button. The EvaluateCanExecute method invokes the command’s CanExecute function and accordingly enables or disables the Target control.

By implementing all UI commands as ICommand objects, we keep both the View and the ViewModel free of command logic and Click handlers. By adopting the command pattern, we give ourselves all the opportunities to achieve low coupling and high cohesion. That is, small and specialized modules that depend on abstractions that can be injected from the outside.

Property Bindings

In XAML we use a special string syntax (“markup extensions”) to bind the value of, say, a ViewModel property, to that of a UI element property:

<TextBox Text="{Binding SomeProperty, Mode=TwoWay, UpdateSourceTrigger=PropertyChanged}" />

As long as the ViewModel implements INotifyPropertyChanged and the property fires the PropertyChanged event when its value changes, WPF can automatically keep the UI in sync with the ViewModel and the ViewModel in sync with the UI. WPF data bindings are extremely flexible and can also bind to static and dynamic resources, or other UI elements, and they are actually slightly more complex than that, but this captures the essence.

Obviously MVVM with MSForms in VBA isn’t going to involve any kind of special string syntax, but the concept of a PropertyBinding can very much be encapsulated into an object (and XAML compiles down to objects and methods, too). At its core, a binding is a pretty simple thing: a source, a target, and a method to update them.

Technically nothing prevents binding a target to any object type (although with limitations, since non-user code won’t be implementing INotifyPropertyChanged), but for the sake of clarity:

  • The binding Source is the ViewModel
  • The SourcePropertyPath is the name of a property of the ViewModel
  • The binding Target is the MSForms control
  • The binding TargetProperty is the name of a property of the MSForms control

Note that the SourcePropertyPath resolves recursively and can be a property of a propertyof a property – as long as the string ultimately resolves to a non-object member.

.BindPropertyPath ViewModel, "SourcePath", Me.PathBox, _
    Validator:=New RequiredStringValidator, _
    ErrorFormat:=AggregateErrorFormatter.Create(ViewModel, _
        ValidationErrorFormatter.Create(Me.PathBox) _ 
            .WithErrorBackgroundColor _
            .WithErrorBorderColor, _
        ValidationErrorFormatter.Create(Me.InvalidPathIcon) _
            .WithTargetOnlyVisibleOnError("SourcePath"), _                
        ValidationErrorFormatter.Create(Me.ValidationMessage1) _
            .WithTargetOnlyVisibleOnError("SourcePath"))

The IBindingManager.BindPropertyPath method is pretty flexible and accepts a number of optional parameters while implementing sensible defaults for common MSForms controls’ “default property binding”. For example, you don’t need to specify a TargetProperty when binding a ViewModel property to a MSForms.TextBox: it will automatically binds to the Text property, but will accept to bind any other property.

The optional arguments are especially useful for custom data validation, but some of them also control various knobs that determine what and how the binding updates.

ValueBehavior
TwoWayBindingBinding will update the source when the target changes, and will update the target when the source changes.
OneWayBindingBinding will update the target when the source changes.
OneWayToSourceBinding will update the source when the target changes.
OneTimeBindingBinding will only update the target once.
The BindingMode enum values
ValueBehavior
OnPropertyChangedBinding will update when the bound property value changes.
OnKeyPressBinding will update the source at each keypress. Only available for TextBox controls. Data validation may prevent the keypress from reaching the UI element.
OnExitBinding will update the source just before target loses focus. Data validation may cancel the exit and leave the caret inside. This update source trigger is the most efficient since it only updates bindings when the user has finished providing a value.
The UpdateSourceTrigger enum values

Property Paths

The binding manager is able to recursively resolve a member path, so if your ViewModel has a ThingSection property that is itself a ViewModel with its own bindings and commands, that itself has a Thing property, know that the binding path can legally be “ThingSection.Thing“, and as long as the Source is the ViewModel object where a ThingSection property exists, and that the ThingSection porperty yields an object that has a Thing property, then all is good and the binding works. If ThingSection were to be Nothing when the binding is updated, then the target is assigned with a default value depending on the type. For example if ThingSection.Thing was bound to some TextBox1 control and the ThingSection property of the ViewModel was Nothing, then the Text property would end up being an empty string – note that this default value may be illegal, depending on what data validation is in place.

Data Validation

Every property binding can attach any IValueValidator implementation that encapsulates specialized, bespoke validation rules. The infrastructure code doesn’t include any custom validator, but the example show how one can be implemented. The interface mandates an IsValid function that returns a Boolean (True when valid), and a user-friendly Message property that the ValidationManager uses to create tooltips.

'@Folder MVVM.Example
Option Explicit
Implements IValueValidator

Private Function IValueValidator_IsValid(ByVal Value As Variant, ByVal Source As Object, ByVal Target As Object) As Boolean
    IValueValidator_IsValid = Len(Trim$(Value)) > 0
End Function

Private Property Get IValueValidator_Message() As String
    IValueValidator_Message = "Value cannot be empty."
End Property

The IsValid method provides you with the Value being validated, the binding Source, and the binding Target objects, which means every validator has access to everything exposed by the ViewModel; note that the method being a Function strongly suggests that it should not have side-effects. Avoid mutating ViewModel properties in a validator, but the message can be constructed dynamically if the validator is made to hold module-level state… although I would really strive to avoid making custom validators stateful.

While the underlying data validation mechanics are relatively complex, believe it or not there is no other step needed to implement custom validation for your property bindings: IBindingManager.BindPropertyPath is happy to take in any validator object, as long as it implements the IValueValidator interface.

Presenting Validation Errors

Without taking any steps to format validation errors, commands that can only execute against a valid ViewModel will automatically get disabled, but the input field with the invalid value won’t give the user any clue. By providing an IValidationErrorFormatter implementation when registering the binding, you get to control whether hidden UI elements should be displayed when there’s a validation error.

The ValidationErrorFormatter class meets most simple scenarios. Use the factory method to create an instance with a specific target UI element, then chain builder method calls to configure the formatting inline with a nice, fluent syntax:

Set Formatter = ValidationErrorFormatter.Create(Me.PathBox) _
                                        .WithErrorBackgroundColor(vbYellow) _
                                        .WithErrorBorderColor
MethodPurpose
CreateFactory method, ensures every instance is created with a target UI element.
WithErrorBackgroundColorMakes the target have a different background color given a validation error. If no color is specified, a default “error background color” (light red) is used.
WithErrorBorderColorMakes the target have a different border color given a validation error. If no color is specified, a default “error border color” (dark red) is used. Method has no effect if the UI control isn’t “flat style” or if the border style isn’t “fixed single”.
WithErrorForeColorMakes the target have a different fore (text) color given a validation error. If no color is specified, a default “error border color” (dark red) is used.
WithErrorFontBoldMakes the target use a bold font weight given a validation error. Method has no effect if the UI element uses a bolded font face without a validation error.
WithTargetOnlyVisibleOnErrorMakes the target UI element normally hidden, only to be made visible given a validation error. Particularly useful with aggregated formatters, to bind the visibility of a label and/or an icon control to the presence of a validation error.
The factory and builder methods of the ValidationErrorFormatter class.

The example code uses an AggregateErrorFormatter to tie multiple ValidationErrorFormatter instances (and thus possibly multiple different target UI controls) to the the same binding.

Value Converters

IBindingManager.BindPropertyPath can take an optional IValueConverter parameter when a conversion is needed between the source and the target, or between the target and the source. One useful value converter can be one like the InverseBooleanConverter implementation, which can be used in a binding where True in the source needs to bind to False in the target.

The interface mandates the presence of Convert and ConvertBack functions, respectively invoked when the binding value is going to the target and the source. Again, pure functions and performance-sensitive implementations should be preferred over side-effecting code.

'@Folder MVVM.Infrastructure.Bindings.Converters
'@ModuleDescription "A value converter that inverts a Boolean value."
'@PredeclaredId
'@Exposed
Option Explicit
Implements IValueConverter

Public Function Default() As IValueConverter
    GuardClauses.GuardNonDefaultInstance Me, InverseBooleanConverter
    Set Default = InverseBooleanConverter
End Function

Private Function IValueConverter_Convert(ByVal Value As Variant) As Variant
    IValueConverter_Convert = Not CBool(Value)
End Function

Private Function IValueConverter_ConvertBack(ByVal Value As Variant) As Variant
    IValueConverter_ConvertBack = Not CBool(Value)
End Function

Converters used in single-directional bindings don’t need to necessarily make both functions return a value that makes sense: sometimes a value can be converted to another but cannot round-trip back to the original, and that’s fine.

String Formatting

One aspect of property bindings I haven’t tackled yet, is the whole StringFormat deal. Once that is implemented and working, the string representation of the target control will be better separated from its actual value. And a sensible default format for some data types (Date, Currency) can even be inferred from the type of the source property!

Another thing string formatting would enable, is the ability to interpolate the value within a string. For example there could be a property binding defined like this:

.BindPropertyPath ViewModel, "NetAmount", Me.NetAmountBox, StringFormat:="USD$ {0:C2}"

And the NetAmountBox would read “USD$ 1,386.77” given the value 1386.77, and the binding would never get confused and would always know that the underlying value is a numeric value of 1386.77 and not a formatted string. Now, until that is done, string formatting probably needs to involve custom value converters. When string formatting works in property bindings, any converter will get invoked before: it’s always going to be the converted value that gets formatted.

ViewModel

Every ViewModel class is inherently application-specific and will look different, but there will be recurring themes:

  • Every field in the View wants to bind to a ViewModel property, and then you’ll want extra properties for various other things, so the ViewModel quickly grows more properties than comfort allows. Make smaller “ViewModel” classes by regrouping related properties, and bind with a property path rather than a plain property name.
  • Property changes need to propagate to the “main” ViewModel (the “data context”) somehow, so making all ViewModel classes fire a PropertyChanged event as appropriate is a good idea. Hold a WithEvents reference to the “child” ViewModel, and handle propagation by raising the “parent” ViewModel’s own PropertyChanged event, all the way up to the “main” ViewModel, where the handler nudges command bindings to evaluate whether commands can execute. One solution could be to register all command bindings with some CommandManager object that would have to implement IHandlePropertyChanged and would relieve the ViewModel of needing to do this.

Each ViewModel should implement at least two interfaces:

  • IViewModel, because we need a way to access the validation error handler and this interface makes a good spot for it.
  • INotifyPropertyChanged, to notify data bindings when a ViewModel property changes.

Here is the IViewModel implementation for the example code – the idea is really to expose properties for the view to bind, and we must not forget to notify handlers when a property value changes – notice the RHS-checking logic in the Property Let member:

'@Folder MVVM.Example
'@ModuleDescription "An example ViewModel implementation for some dialog."
'@PredeclaredId
Implements IViewModel
Implements INotifyPropertyChanged
Option Explicit

Public Event PropertyChanged(ByVal Source As Object, ByVal PropertyName As String)

Private Type TViewModel
    
    'INotifyPropertyChanged state:
    Handlers As Collection
    
    'CommandBindings:
    SomeCommand As ICommand
    
    'Read/Write PropertyBindings:
    SourcePath As String
    SomeOption As Boolean
    SomeOtherOption As Boolean
    
End Type

Private this As TViewModel
Private WithEvents ValidationHandler As ValidationManager

Public Function Create() As IViewModel
    GuardClauses.GuardNonDefaultInstance Me, ExampleViewModel, TypeName(Me)
    
    Dim result As ExampleViewModel
    Set result = New ExampleViewModel
    
    Set Create = result
End Function

Public Property Get Validation() As IHandleValidationError
    Set Validation = ValidationHandler
End Property

Public Property Get SourcePath() As String
    SourcePath = this.SourcePath
End Property

Public Property Let SourcePath(ByVal RHS As String)
    If this.SourcePath <> RHS Then
        this.SourcePath = RHS
        OnPropertyChanged "SourcePath"
    End If
End Property

Public Property Get SomeOption() As Boolean
    SomeOption = this.SomeOption
End Property

Public Property Let SomeOption(ByVal RHS As Boolean)
    If this.SomeOption <> RHS Then
        this.SomeOption = RHS
        OnPropertyChanged "SomeOption"
    End If
End Property

Public Property Get SomeOtherOption() As Boolean
    SomeOtherOption = this.SomeOtherOption
End Property

Public Property Let SomeOtherOption(ByVal RHS As Boolean)
    If this.SomeOtherOption <> RHS Then
        this.SomeOtherOption = RHS
        OnPropertyChanged "SomeOtherOption"
    End If
End Property

Public Property Get SomeCommand() As ICommand
    Set SomeCommand = this.SomeCommand
End Property

Public Property Set SomeCommand(ByVal RHS As ICommand)
    Set this.SomeCommand = RHS
End Property

Public Property Get SomeOptionName() As String
    SomeOptionName = "Auto"
End Property

Public Property Get SomeOtherOptionName() As String
    SomeOtherOptionName = "Manual/Browse"
End Property

Public Property Get Instructions() As String
    Instructions = "Lorem ipsum dolor sit amet, consectetur adipiscing elit."
End Property

Private Sub OnPropertyChanged(ByVal PropertyName As String)
    RaiseEvent PropertyChanged(Me, PropertyName)
    Dim Handler As IHandlePropertyChanged
    For Each Handler In this.Handlers
        Handler.OnPropertyChanged Me, PropertyName
    Next
End Sub

Private Sub Class_Initialize()
    Set this.Handlers = New Collection
    Set ValidationHandler = ValidationManager.Create
End Sub

Private Sub INotifyPropertyChanged_OnPropertyChanged(ByVal Source As Object, ByVal PropertyName As String)
    OnPropertyChanged PropertyName
End Sub

Private Sub INotifyPropertyChanged_RegisterHandler(ByVal Handler As IHandlePropertyChanged)
    this.Handlers.Add Handler
End Sub

Private Property Get IViewModel_Validation() As IHandleValidationError
    Set IViewModel_Validation = ValidationHandler
End Property

Private Sub ValidationHandler_PropertyChanged(ByVal Source As Object, ByVal PropertyName As String)
    OnPropertyChanged PropertyName
End Sub

Nothing much of interest here, other than the INotifyPropertyChanged implementation and the fact that a ViewModel is really just a fancy word for a class that exposes a bunch of properties that magically keep in sync with UI controls!

View

In a Smart UI, that module is, more often than not, a complete wreck. In Model-View-Presenter it quickly gets cluttered with many one-liner event handlers, and something just feels clunky about the MVP pattern. Now, I’m trying really hard, but I can’t think of a single reason to not want UserForm code-behind to look like this all the time… this is absolutely all of it, there’s no cheating going on:


'@Folder MVVM.Example
'@ModuleDescription "An example implementation of a View."
Implements IView
Implements ICancellable
Option Explicit

Private Type TView
    'IView state:
    ViewModel As ExampleViewModel
    
    'ICancellable state:
    IsCancelled As Boolean
    
    'Data binding helper dependency:
    Bindings As IBindingManager
End Type

Private this As TView

'@Description "A factory method to create new instances of this View, already wired-up to a ViewModel."
Public Function Create(ByVal ViewModel As ExampleViewModel, ByVal Bindings As IBindingManager) As IView
    GuardClauses.GuardNonDefaultInstance Me, ExampleView, TypeName(Me)
    GuardClauses.GuardNullReference ViewModel, TypeName(Me)
    GuardClauses.GuardNullReference Bindings, TypeName(Me)
    
    Dim result As ExampleView
    Set result = New ExampleView
    
    Set result.Bindings = Bindings
    Set result.ViewModel = ViewModel
    
    Set Create = result
    
End Function

Private Property Get IsDefaultInstance() As Boolean
    IsDefaultInstance = Me Is ExampleView
End Property

'@Description "Gets/sets the ViewModel to use as a context for property and command bindings."
Public Property Get ViewModel() As ExampleViewModel
    Set ViewModel = this.ViewModel
End Property

Public Property Set ViewModel(ByVal RHS As ExampleViewModel)
    GuardClauses.GuardExpression IsDefaultInstance, TypeName(Me)
    GuardClauses.GuardNullReference RHS
    
    Set this.ViewModel = RHS
    InitializeBindings

End Property

'@Description "Gets/sets the binding manager implementation."
Public Property Get Bindings() As IBindingManager
    Set Bindings = this.Bindings
End Property

Public Property Set Bindings(ByVal RHS As IBindingManager)
    GuardClauses.GuardExpression IsDefaultInstance, TypeName(Me)
    GuardClauses.GuardDoubleInitialization this.Bindings, TypeName(Me)
    GuardClauses.GuardNullReference RHS
    
    Set this.Bindings = RHS

End Property

Private Sub BindViewModelCommands()
    With Bindings
        .BindCommand ViewModel, Me.OkButton, AcceptCommand.Create(Me)
        .BindCommand ViewModel, Me.CancelButton, CancelCommand.Create(Me)
        .BindCommand ViewModel, Me.BrowseButton, ViewModel.SomeCommand
        '...
    End With
End Sub

Private Sub BindViewModelProperties()
    With Bindings
        
        .BindPropertyPath ViewModel, "SourcePath", Me.PathBox, _
            Validator:=New RequiredStringValidator, _
            ErrorFormat:=AggregateErrorFormatter.Create(ViewModel, _
                ValidationErrorFormatter.Create(Me.PathBox).WithErrorBackgroundColor.WithErrorBorderColor, _
                ValidationErrorFormatter.Create(Me.InvalidPathIcon).WithTargetOnlyVisibleOnError("SourcePath"), _
                ValidationErrorFormatter.Create(Me.ValidationMessage1).WithTargetOnlyVisibleOnError("SourcePath"))
        
        .BindPropertyPath ViewModel, "Instructions", Me.InstructionsLabel
        
        .BindPropertyPath ViewModel, "SomeOption", Me.OptionButton1
        .BindPropertyPath ViewModel, "SomeOtherOption", Me.OptionButton2
        .BindPropertyPath ViewModel, "SomeOptionName", Me.OptionButton1, "Caption", OneTimeBinding
        .BindPropertyPath ViewModel, "SomeOtherOptionName", Me.OptionButton2, "Caption", OneTimeBinding
        
        '...
        
    End With
End Sub

Private Sub InitializeBindings()
    If ViewModel Is Nothing Then Exit Sub
    BindViewModelProperties
    BindViewModelCommands
    Bindings.ApplyBindings ViewModel
End Sub

Private Sub OnCancel()
    this.IsCancelled = True
    Me.Hide
End Sub

Private Property Get ICancellable_IsCancelled() As Boolean
    ICancellable_IsCancelled = this.IsCancelled
End Property

Private Sub ICancellable_OnCancel()
    OnCancel
End Sub

Private Sub IView_Hide()
    Me.Hide
End Sub

Private Sub IView_Show()
    Me.Show vbModal
End Sub

Private Function IView_ShowDialog() As Boolean
    Me.Show vbModal
    IView_ShowDialog = Not this.IsCancelled
End Function

Private Property Get IView_ViewModel() As Object
    Set IView_ViewModel = this.ViewModel
End Property

Surely some tweaks will be made over the next couple of weeks as I put the UI design pattern to a more extensive workout with the Rubberduck website content maintenance app – but having used MVVM in C#/WPF for many years, I already know that this is how I want to be coding VBA user interfaces going forward.

I really love how the language has had the ability to make this pattern work, all along.

To be continued…