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.

Rubberduck Annotations

I wrote about this unfortunately hard-to-discover feature in 2017, but a lot has happened since then, and there’s 5 times more of you now! The wiki is essentially up-to-date, but I’m not sure of its viewership. So here’s a recap of annotations in the late Rubberduck 2.4.1.x pre-release builds, that 2.5.0.x will launch with.

What we call “annotations” are special comments that look like these:

'@Folder("MyProject.Abstract")
'@ModuleDescription("An interface that describes an object responsible for something.")
'@Interface
'@Exposed

'@Description("Does something")
Public Sub DoSomething()
End Sub

Syntax

Rubberduck’s parser includes a grammar rule that captures these special comments, such that we “see” them like any other language syntax element (tokens), and can analyze them as such, too.

The syntax is rather simple, and is made to look like a procedure call – note that string arguments must be surrounded with double quotes:

'@AnnotationName arg1, arg2, "string argument"

If desired, parentheses can be used, too:

'@AnnotationName(arg1, arg2)
'@AnnotationName("string argument")

Whether you use one notation or the other is entirely up to personal preference, both are completely equivalent. As with everything else, consistency should be what matters.

There’s an inspection that flags illegal/unsupported annotations that you, if you’re using this @PseudoSyntax for other purposes, will probably want to disable: that’s done by setting its severity level to DoNotShow in the inspection settings, or by simply clicking “disable this inspection” from the inspection results toolwindow.

Keep in mind that while they are syntactically comments as far as VBA is concerned, to Rubberduck parsing the argument list of an annotation needs to follow strict rules. This parses correctly:

'@Folder "Some.Sub.Folder" @ModuleDescription "Some description" : some comment

Without the : instruction separator token, the @ModuleDescription annotation parses as a regular comment. After : though, anything goes.

There are two distinct types of annotation comments: some annotations are only valid at module level, and others are only valid at member level.

Module Annotations

Module-level annotations apply to the entire module, and must appear in that module’s declarations section. Personally, I like having them at the very top, above Option Explicit. Note that if there’s no declaration under the last annotation, and no empty line, then the placement becomes visually ambiguous – even though Rubberduck correctly understands it, avoid this:

Option Explicit
'@Description("description here")
Public Sub DoSomething() '^^^ is this the module's or the procedure's annotation?
End Sub

Let it breathe – always have an empty line between the end of the module’s declarations section (there should always at least be Option Explicit there) and the module’s body:

Option Explicit
'@Folder("MyProject") : clearly belongs to the module

'@Description("description here")
Public Sub DoSomething() '^^^ clearly belongs to the procedure
End Sub

What follows is a list of every single module-level annotation currently supported (late v2.4.1.x pre-release builds), that v2.5.0 will launch with.

@Folder

The Visual Basic Editor regroups modules in its Project Explorer toolwindow, by component type: you get a folder for your “Modules”, another folder for your “Class Modules”; if you have userforms they’re all under a “Forms” folder, and then the document modules are all lumped under some “Microsoft Excel Objects” folder (in an Excel host, anyway). While this grouping is certainly fine for tiny little automation scripts, it makes navigation wildly annoying as soon as a project starts having multiple features and responsibilities.

In a modern IDE like Visual Studio, code files can be regrouped by functionality into a completely custom folder hierarchy: you get to have a form in the same folder as the presenter class that uses it, for example. With Rubberduck’s Code Explorer toolwindow, you get to do exactly the same, and the way you do this is with @Folder annotations.

'@Folder("Root.Parent.Child")
Option Explicit

The @Folder annotation takes a single string argument representing the “virtual folder” a module should appear under, where a dot (.) denotes a sub-folder – a bit like .NET namespaces. Somewhere deep in the history of this annotation, there’s a version that’s even named @Namespace. “Folder” was preferred though, because “Namespace” was deemed too misleading for VBA/VB6, given the language doesn’t support them: all module names under a given project must still be unique. The Code Explorer toolwindow uses these annotations to build the folder hierarchy to organize module nodes under, but the folders don’t actually exist: they’re just a representation of the annotation comments in existing modules – and that is why there is no way to create a new, empty folder to drag-and-drop modules into.

It is strongly recommended to adopt a standard and consistent PascalCase naming convention for folder names: future Rubberduck versions might very well support exporting modules accordingly with these folder annotations, so these “virtual folders” might not be “virtual” forever; by using a PascalCase naming convention, you not only adopt a style that can be seamlessly carried into the .NET world; you also make your folders future-proof. Avoid spaces and special characters that wouldn’t be legal in a folder name under Windows.

The ModuleWithoutFolder inspection (under “Rubberduck Opportunities”), if enabled, will warn you of modules where this annotation is absent. By default, Rubberduck’s Code Explorer will put all modules under a single root folder named after the VBA project. While this might seem rather underwhelming, it was a deliberate decision to specifically not re-create the “by component type” grouping of the VBE and encourage our users to instead regroup modules by functionality.

@IgnoreModule

The @IgnoreModule annotation is automatically added by the “Ignore in Module” inspection quick-fix, which effectively disables a specific code inspection, but only in a specific module. This can be useful for inspections that have false positives, such as procedure not used firing results in a module that contains public parameterless procedures that are invoked from ActiveX controls on a worksheet, which Rubberduck isn’t seeing (hence the false positives), but that are otherwise useful, such that you don’t necessarily want to completely disable the inspection (i.e. set its severity level to DoNotShow).

If no arguments are specified, this annotation will make all inspections skip the module. To skip a specific inspection, you may provide its name (minus the Inspection suffix) as an argument. To ignore multiple inspections, you can separate them with commas like you would any other argument list:

'@IgnoreModule ProcedureNotUsed, ParameterNotUsed

Alternatively, this annotation may be supplied multiple times:

'@IgnoreModule ProcedureNotUsed
'@IgnoreModule ParameterNotUsed

Use the : instruction separator to terminate the argument list and add an explanatory comment as needed:

'@IgnoreModule ProcedureNotUsed : These are public macros attached to shapes on Sheet1

Note that the arguments (inspection names) are not strings: enclosing the inspection names in string literals will not work.

@TestModule

This was the very first annotation supported by Rubberduck. This annotation is only legal in standard/procedural modules, and marks a module for test discovery: the unit testing engine will only scan these modules for unit tests. This annotation does not support any parameters.

@ModuleDescription(“value”)

Given a string value, this annotation can be used to control the value of the module’s hidden VB_Description attribute, which determines the module’s “docstring” – a short description that appears in the VBE’s Object Browser, and that Rubberduck displays in its toolbar and in the Code Explorer.

Because Rubberduck can’t alter module attributes in document modules, this annotation is illegal in modules representing objects owned by the host application (i.e. “document” modules), such as Worksheet modules and ThisWorkbook.

@PredeclaredId

This annotation does not support any parameters, and can be used to control the value of the hidden VB_PredeclaredId attribute, which determines whether a class has a default instance. When a class has a default instance, its members can be invoked without an instance variable (rather, using an implicit one named after the class itself), like you did every single time you’ve ever written UserForm1.Show – but now you get to have a default instance for your own classes, and this opens up a vast array of new possibilities, most notably the ability to now write factory methods in the same class module as the class being factory-created, effectively giving you the ability to initialize new object instances with parameters, just like you would if VBA classes had parameterized constructors:

Dim something As Class1
Set something = Class1.Create("test", 42)

@Exposed

VBA classes are private by default: this means if you make a VBA project that references another, then you can’t access that class from the referencing project. By setting the class’ instancing property to PublicNotCreatable, a referencing project is now able to consume the class (but the class can only be instantiated inside the project that defines it… and that’s where factory methods shine).

This annotation visibly documents that the class’ instancing property has a non-default value (this can easily be modified in the VBE’s properties toolwindow).

@Interface

In VBA every class modules defines a public interface: every class can Implements any other class, but not all classes are created equal, and in the vast majority of the time what you want to follow the Implements keyword will be the name of an abstract interface. An abstract interface might look like this:

'@Interface
Option Explicit

Public Sub DoSomething()
End Sub

Adding this annotation to a module serves as metadata that Rubberduck uses when analyzing the code: the Code Explorer will display these modules with a dedicated “interface” icon, and an inspection will be able to flag procedures with a concrete implementation in these modules.

@NoIndent

Rubberduck’s Smart Indenter port can indent your entire VBA project in a few milliseconds, but automatically indenting a module can have undesirable consequences, such as losing hidden member attributes. Use this annotation to avoid accidentally wiping hidden attributes in a module: the indenter will skip that module when bulk-indenting the project.


Member Annotations

Member-level annotations apply to the entire procedure they’re annotating, and must be located immediately over the procedure’s declaration:

'@Description("Does something")
Public Sub DoSomething()
    '...
End Sub

As with module annotations, multiple member annotations can be specified for the same procedure – either by stacking them, or enumerating them one after the other:

'@DefaultMember
'@Description("Gets the item at the specified index")
Public Property Get Item(ByVal index As Long) As Object
    '...
End Property

Member annotations that aren’t immediately above the procedure declaration, will be flagged as illegal by the IllegalAnnotation inspection:

'@Description("Does something") : <~ annotation is illegal/misplaced

Public Sub DoSomething()
    '...
End Sub

@Description

This very useful annotation controls the value of the member’s hidden VB_Description attribute, which defines a docstring that appears in the bottom panel of the Object Browser when the member is selected – Rubberduck also displays this content in the context-sensitive (selection-dependent) label in the Rubberduck VBIDE toolbar.

Toolbar label content is dependent on the current selection in the editor and includes the value of the hidden attribute’s value.

@Ignore

Similar to @IgnoreModule, the purpose of the member-level @Ignore annotation is to get specific inspections to ignore the annotated procedure: it works identically.

@DefaultMember

Only one single member of a class can be the class’ default member. Default members should generally be avoided, but they are very useful for indexed Item properties of custom collection classes. This annotation takes no arguments.

@Enumerator

Custom collections that need to support For Each enumeration are required to have a member that returns an IUnknown, and hidden flags and attributes: this annotation clearly identifies the special member, and gets the hidden flags and attributes right every time.

'@Enumerator
Public Property Get NewEnum() As IUnknown
    Set NewEnum = encapsulatedCollection.[_NewEnum]
End Property

@ExcelHotkey

This rather specific annotation works in Excel-hosted VBA projects (as of this writing its absence may cause inspection false positives in other host applications, like Microsoft Word).

When the VBA project is hosted in Microsoft Excel, you can use this annotation to assign hotkeys using the same mechanism Excel uses to map hotkeys to recorded macros.

'@ExcelHotkey "D" : Ctrl+Shift+D will invoke this procedure in Excel
Public Sub DoSomething()
    '...
End Sub

'@ExcelHotkey "d" : Ctrl+D will invoke this procedure in Excel
Public Sub DoSomethingElse()
    '...
End Sub

Note that the annotation will work regardless of whether the argument is treated as a string literal or not – only the first character of the annotation argument is used, and its case determines whether the Shift key is involved in the hotkey combination (all hotkeys involve the Ctrl key): use an uppercase letter for a Ctrl+Shift hotkey.

@Obsolete

Code under continued maintenance is constantly evolving, and sometimes in order to avoid breaking existing call sites, a procedure might need to be replaced by a newer version, while keeping the old one around: this annotation can be used to mark the old version as obsolete with an explanatory comment, and inspections can flag all uses of the obsolete procedure:

'@Obsolete("Use DoSomethingElse instead.")
Public Sub DoSomething()
    '...
End Sub

Public Sub DoSomethingElse()
    '...
End Sub
The argument string appears in the inspection results for each use of the obsolete member.

Test Method Annotations

These annotations have been in Rubberduck for a very long time, and they are actually pretty easy to discover since they are automatically added by Rubberduck when adding test modules and test methods using the UI commands – but since Test Settings can be configured to not include setup & teardown stubs, it can be easy to forget they exist and what they do.

@TestMethod

This annotation is used in test modules to identify test methods: every test must be marked with this annotation in order to be discoverable as a test method. It is automatically added by Rubberduck’s “add test method” commands, but needs to be added manually if a test method is typed manually in the editor rather than inserted by Rubberduck.

This annotation supports a string argument that determines the test’s category, which appears in the Test Explorer toolwindow and enables grouping by category. If no category argument is specified, “Uncategorized” is used as a default:

@TestMethod("Some Category")
Private Sub TestMethod1()
'...
End Sub

The other @TestXxxxx member annotations are used for setup & teardown. If test settings have the “Test module initialization/cleanup” option selected, then @ModuleInitialize and @ModuleCleanup procedure stubs are automatically added to a new test module. If test settings have “Test method initialization/cleanup” selected, then @TestInitialize and @TestCleanup procedure stubs are automatically added a new test modules.

@TestInitialize

In test modules, this annotation marks procedures that are invoked before every single test in the module. Use that method to run setup/initialization code that needs to execute before each test. Each annotated procedure is invoked, but the order of invocation cannot be guaranteed… however there shouldn’t be a need to have more than one single such initialization method in the module.

@TestCleanup

Also used in test modules, this annotation marks methods that are invoked after every single test in that test module. Use these methods to run teardown/cleanup code that needs to run after each test. Again, each annotated procedure is invoked, but the order of invocation cannot be guaranteed – and there shouldn’t be a need to have more than one single such cleanup method in the module.

@ModuleInitialize

Similar to @TestInitialize, but for marking procedures that are invoked once for the test module, before the tests start running. Use these procedures to run setup code that needs to run before the module’s tests begin to run; each annotated procedure will be invoked, but the order of invocation cannot be guaranteed. Again, only one such initialization procedure should be needed, if any.

@ModuleCleanup

Similar to @TestCleanup, but for marking procedures that are invoked once for the test module, after all tests in the module have executed. Use these procedures to run teardown/cleanup code that needs to run after all module’s tests have completed; each annotated procedure will be invoked, but the order of invocation isn’t guaranteed. Only one such cleanup procedure should be needed, if any.


Annotations are one of Rubberduck’s most useful but unfortunately also one of its most obscure and hard-to-discover features. Fortunately, we have plans to surface them as right-click context menu commands in the 2.5.x release cycle.

Factories: Parameterized Object Initialization

Creating objects is something we do all the time. When we Set foo = New Something, we create a new instance of the Something class and assign that object reference to the foo variable, which would have been declared locally with Dim foo As Something.

With New

Often, you wish to instantiate Something with initial values for its properties – might look like this:

Dim foo As Something
Set foo = New Something
With foo
    .Bar = 42
    .Ducky = "Quack"
    '...
End With

Or, you could be fancy and make Something have a Self property that returns, well, the instance itself, like this:

Public Property Get Self() As Something
    Set Self = Me
End Property

But why would we do that? Because then we can leverage the rather elegant With New syntax:

Dim foo As Something
With New Something
    .Bar = 42
    .Ducky = "Quack"
    '...
    Set foo = .Self
End With

The benefits are perhaps more apparent with a factory method:

Public Function NewSomething(ByVal initialBar As Long, ByVal initialDucky As String) As Something
    With New Something
        .Bar = initialBar
        .Ducky = initialDucky
        Set NewSomething = .Self
    End With
End Function

See, no local variable is needed here, the With block holds the object reference. If we weren’t passing that reference down the call stack by returning it to the caller, the End With would have terminated that object. Not everybody knows that a With block can own an object reference like this, using With New. Without the Self property, a local variable would be needed in order to be able to assign the return value, because a With block doesn’t provide a handle to the object reference it’s holding.

Now the calling code can do this:

Dim foo As Something
Set foo = Factories.NewSomething(42, "Quack")

Here the NewSomething function is located in a standard module (.bas) named Factories. The code would have also been legal without qualifying NewSomething with the module name, but if someone is maintaining that code without Rubberduck to tell them by merely clicking on the identifier, meh, too bad for them they’ll have to Shift+F2 (go to definition) on NewSomething and waste time and break their momentum navigating to the Factories module it’s defined in – or worse, looking it up in the Object Browser (F2).

Where to put it?

In other languages, objects can be created with a constructor. In VBA you can’t have that, so you use a factory method instead. Factories manufacture objects, they create things.

In my opinion, the single best place to put a factory method isn’t in a standard/procedural module though – it’s on the class itself. I want my calling code to look something like this:

Dim foo As Something
Set foo = Something.Create(42, "Quack")

Last thing I want is some “factory module” that exposes a method for creating instances of every class in my project. But how can we do this? The Create method can’t be invoked without an instance of the Something class, right? But what’s happening here, is that the instance is being automatically created by VBA; that instance is named after the class itself, and there’s a VB_Attribute in the class header that you need to tweak to activate it:

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "Something"      '#FunFact controlled by the "Name" property of the class module
Attribute VB_GlobalNameSpace = False '#FunFact VBA ignores this attribute
Attribute VB_Creatable = False       '#FunFact VBA ignores this attribute
Attribute VB_PredeclaredId = True    '<~ HERE!
Attribute VB_Exposed = False         '#FunFact controlled by the "Instancing" property of the class module

The attribute is VB_PredeclaredId, which is False by default. At a low level, each object instance has an ID; by toggling this attribute value, you tell VBA to pre-declare that ID… and that’s how you get what’s essentially a global-scope free-for-all instance of your object.

That can be a good thing… but as is often the case with forms (which also have a predeclared ID), storing state in that instance leads to needless bugs and complications.

Interfaces

The real problem is that we really have two interfaces here, and one of them (the factory) shouldn’t be able to access instance data… but it needs to be able to access the properties of the object it’s creating!

If only there was a way for a VBA class to present one interface to the outside world, and another to the Create factory method!

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "ISomething"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Public Property Get Bar() As Long
End Property

Public Property Get Ducky() As String
End Property

This would be some ISomething class: an interface that the Something class will implement.

The Something class would look like this- Notice that it only exposes Property Get accessors, and that the Create method returns the object through the ISomething interface:

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "Something"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Type TSomething
    Bar As Long
    Ducky As String
End Type

Private this As TSomething
Implements ISomething

Public Function Create(ByVal initialBar As Long, ByVal initialDucky As String) As ISomething
    With New Something
        .Bar = initialBar
        .Ducky = initialDucky
        Set Create = .Self
    End With
End Function

Public Property Get Self() As ISomething
    Set Self = Me
End Property

Public Property Get Bar() As Long
    Bar = this.Bar
End Property

Friend Property Let Bar(ByVal value As Long)
    this.Bar = value
End Property

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

Friend Property Let Ducky(ByVal value As String)
    this.Ducky = value
End Property

Private Property Get ISomething_Bar() As Long
    ISomething_Bar = Bar
End Property

Private Property Get ISomething_Ducky() As String
    ISomething_Ducky = Ducky
End Property

The Friend properties would only be accessible within that project; if that’s not a concern then they could also be Public, doesn’t really matter – the calling code only really cares about the ISomething interface:

With Something.Create(42, "Quack")
    Debug.Print .Bar 'prints 42
    .Bar = 42 'illegal, member not on interface
End With

Here the calling scope is still tightly coupled with the Something class though. But if we had a factory interface…

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "ISomethingFactory"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Public Function Create(ByVal initialBar As Long, ByVal initialDuck As String) As ISomething
End Function

…and made Something implement that interface…

Implements ISomething
Implements ISomethingFactory

Public Function Create(ByVal initialBar As Long, ByVal initialDucky As String) As ISomething
    With New Something
        .Bar = initialBar
        .Ducky = initialDucky
        Set Create = .Self
    End With
End Function

Private Function ISomethingFactory_Create(ByVal initialBar As Long, ByVal initialDucky As String) As ISomething
    Set ISomethingFactory_Create = Create(initialBar, initialDucky)
End Function

…now we basically have an abstract factory that we can pass around to everything that needs to create an instance of Something or, even cooler, of anything that implements the ISomething interface:

Option Explicit

Public Sub Main()
    Dim factory As ISomethingFactory
    Set factory = Something.Self
    With MyMacro.Create(factory)
        .Run
    End With
End Sub

Of course this is a contrived example. Imagine Something is rather some SqlDataService encapsulating some ADODB data access, and suddenly it’s possible to execute MyMacro.Run without hitting a database at all, by implementing the ISomething and ISomethingFactory interfaces in some FakeDataService class that unit tests can use to test-drive the logic without ever needing to hit a database.

A factory is a creational pattern that allows us to parameterize the creation of an object, and even abstract away the very concept of creating an instance of an object, so much that the concrete implementation we’re actually coding against, has no importance anymore – all that matters is the interface we’re using.

Using interfaces, we can segregate parts of our API into different “views” of the same object and, benefiting from coding conventions, achieve get-only properties that can only be assigned when the object is initialized by a factory method.

If you really want to work with a specific implementation, you can always couple your code with a specific Something – but if you stick to coding against interfaces, you’ll find that writing unit tests to validate your logic without testing your database connections, the SQL queries, the presence of the data in the database, the network connectivity, and all the other things that can go wrong, that you have no control over, and that you don’t need to cover in a unit test, …will be much easier.

The whole setup likely isn’t a necessity everywhere, but abstract factories, factory methods, and interfaces, remain useful tools that are good to have in one’s arsenal… and Rubberduck will eventually provide tooling to generate all that boilerplate code.

Sounds like fun? Help us do it!

VBA Trap: Default Members

The key to writing clear, unambiguous code, is rather simple:

Do what you say; say what you do.

VBA has a number of features that make it easy to not even realize you’re writing code that doesn’t do what it says it does.

One of the reasons for that, is the existence of default members – under the guise of what appears to be simpler code, member calls are made implicitly.

If you know what’s going on, you’re probably fine. If you’re learning, or you’re just unfamiliar with the API you’re using, there’s a trap before your feet, and both run-time and compile-time errors waiting to happen.

Example

Consider this seemingly simple code:

myCollection.Add ActiveSheet.Cells(1, 1), ActiveSheet.Cells(1, 1)

It’s adding a Range object, using the String representation of Range.[_Default] as a key. That’s two very different things, done by two bits of identical code. Clearly that snippet does more than just what it claims to be doing.


Discovering Default Members

One of the first classes you might encounter, might be the Collection class. Bring up the Object Browser (F2) and find it in the VBA type library: you’ll notice a little blue dot next to the Item function’s icon:

Collection.Item

Whenever you encounter that blue dot in a list of members, you’ve found the default member of the class you’re looking at.

That’s why the Object Browser is your friend – even though it can list hidden members (that’s toggled via a somewhat hidden command buried the Object Browser‘s context menu), IntelliSense /autocomplete doesn’t tell you as much:

IntelliSense-Collection.Item

Rubberduck’s context-sensitive toolbar has an opportunity to display that information, however that wouldn’t help discovering default members:

rubberduck-collection-item.png

Until Rubberduck reinvents VBA IntelliSense, the Object Browser is all you’ve got.


What’s a Default Member anyway?

Any class can have a default member, and only one single member can be the default.

When a class has a default member, you can legally omit that member when working with an instance of that class.

In other words, myCollection.Item(1) is exactly the same as myCollection(1), except the latter is implicitly invoking the Item function, while the former is explicit about it.


Can my classes have a default member?

You too can make your own classes have a default member, by specifying a UserMemId attribute value of 0​ for that member.

Unfortunately only the Description attribute can be given a value (in the Object Browser, locate and right-click the member, select properties) without removing/exporting the module, editing the exported .cls file, and re-importing the class module into the VBA project.

An Item property that looks like this in the VBE:

Public Property Get Item(ByVal index As Long) As Variant
End Property

Might look like this once exported:

Public Property Get Item(ByVal index As Long) As Variant
Attribute Item.VB_Description = "Gets or sets the element at the specified index."
Attribute Item.VB_UserMemId = 0
End Property

It’s that VB_UserMemId member attribute that makes Item the default member of the class. The VB_Description member attribute determines the docstring that the Object Browser displays in its bottom panel, and that Rubberduck displays in its context-sensitive toolbar.

Whatever you do, DO NOT make a default member that returns an instance of the class it’s defined in. Unless you want to crash your host application as soon as the VBE tries to figure out what’s going on.


What’s Confusing About it?

There’s an open issue (now closed) detailing the challenges implicit default members pose. If you’re familiar with Excel.Range, you know how it’s pretty much impossible to tell exactly what’s going on when you invoke the Cells member (see Stack Overflow).

You may have encountered MSForms.ReturnBoolean before:

Private Sub ComboBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If Not IsNumeric(Chr(KeyAscii)) Then KeyAscii = 0
End Sub

The reason you can assign KeyAscii = 0 and have any effect with that assignment (noticed it’s passed ByVal), is because MSForms.ReturnInteger is a class that has, you guessed it, a default member – compare with the equivalent explicit code:

Private Sub ComboBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If Not IsNumeric(Chr(KeyAscii.Value)) Then KeyAscii.Value = 0
End Sub

And now everything makes better sense. Let’s look at common Excel VBA code:

Dim foo As Range
foo = Range("B12") ' default member Let = default member Get / error 91
Set foo = Range("B12") ' sets the object reference '...

If foo is a Range object that is already assigned with a valid object reference, it assigns foo.Value with whatever Range("B12").Value returns. If foo happened to be Nothing at that point, run-time error 91 would be raised. If we added the Set keyword to the assignment, we would now be assigning the actual object reference itself. Wait, there’s more.

Dim foo As Variant
Set foo = Range("B12") ' foo becomes Variant/Range
foo = Range("B12") ' Variant subtype is only known at run-time '...

If foo is a Variant, it assigns Range("B12").Value (given multiple cells e.g. Range("A1:B12").Value, foo becomes a 2D Variant array holding the values of every cell in the specified range), but if we add Set in front of the instruction, foo will happily hold a reference to the Range object itself. But what if foo has an explicit value type?

Dim foo As String
Set foo = Range("B12") ' object required
foo = Range("B12") ' default member Get and implicit type conversion '...

If foo is a String and the cell contains a #VALUE! error, a run-time error is raised because an error value can’t be coerced into a String …or any other type, for that matter. Since String isn’t an object type, sticking a Set in front of the assignment would give us an “object required” compile error.

Add to that, that Range is either a member of a global-scope object representing whichever worksheet is the ActiveSheet if the code is written in a standard module, or a member of the worksheet itself if the code is written in a worksheet module, and it becomes clear that this seemingly simple code is riddled with assumptions – and assumptions are usually nothing but bugs waiting to surface.

See, “simple” code really isn’t all that simple after all. Compare to a less naive / more defensive approach:

Dim foo As Variant foo = ActiveSheet.Range("B12").Value
If Not IsError(foo) Then
Dim bar As String
bar = CStr(foo) '...
End If

Now prepending a Set keyword to the foo assignment no longer makes any sense, since we know the intent is to get the .Value off the ActiveSheet. We’re reading the cell value into an explicit Variant and explicitly ensuring the Variant subtype isn’t Variant/Error before we go and explicitly convert the value into a String.

Write code that speaks for itself:

  • Avoid implicit default member calls
  • Avoid implicit global qualifiers (e.g. [ActiveSheet.]Range)
  • Avoid implicit type conversions from Variant subtypes

Bang (!) Operator

When the default member is a collection class with a String indexer, VBA allows you to use the Bang Operator ! to… implicitly access that indexer and completely obscure away the default member accesses:

Debug.Print myRecordset.Fields.Item("Field1").Value 'explicit
Debug.Print myRecordset!Field1 'all-implicit

Here we’re looking at ADODB.Recordset.Fields being the default member of ADODB.Recordset; that’s a collection class with an indexer that can take a String representing the field name. And since ADODB.Field has a default property, that too can be eliminated, making it easy to… completely lose track of what’s really going on.


Can Rubberduck help / Can I help Rubberduck?

As of this writing, Rubberduck has all the information it needs to issue inspection results as appropriate… assuming everything is early-bound (i.e. not written against Variant or Object, which means the types involved are only known to VBA at run-time).

In fact, there’s already an Excel-specific inspection addressing implicit ActiveSheet references, that would fire a result given an unqualified Range (or Cells, Rows, Columns, or Names) member call.

ImplicitActiveSheetReference

This inspection used to fire a result even when the code was written in a worksheet module, making it a half-lie: without Me. qualifying the call, Range("A1") in a worksheet module is actually implicitly referring to that worksheet…and changing the code to explicitly refer to ActiveSheet would actually change the behavior of the code. Rubberduck has since been updated to understand these implications.

Another inspection flagging implicit default member calls has also been implemented with a quick-fix to expand the default member call, and bang operators can now be expanded to full notation (in the entire project at once if you like) with a single click, and inspections can flag bang notation, unbound bang notation, recursive bang notation,

Let-assignments involving implicit type conversions are also something we need to look into. Help us do it! This inspection also implies resolving the type of the RHS expression – a capability we’re just barely starting to leverage.

If you’re curious about Rubberduck’s internals and/or would love to learn some serious C#, don’t hesitate to create an issue on our repository to ask anything about our code base; our team is more than happy to guide new contributors in every area!