Extending the VBA Extensibility Library

By Posted on

Problem

The Microsoft Visual Basic for Applications Extensibility library let’s us meta-program VBA, but the way it handles (or rather, doesn’t handle) getting to the actual subs and functions is clunky at best. I decided to write a few class modules to make it easier.

Considering this can be kind of dangerous to do, I want to know that it’s working the way I think it does without unintended side effects. Of course, I’m also interested in other feedback. I’d like to gauge if I’ve learned anything over the last few days here. I feel like I have the logic and style pretty tight, so I’m particularly interested in hearing thoughts on how I handled the object model.

There are three classes:

  1. vbeProcedure – does most of the heavy lifting of getting us the procedures.
  2. vbeProcedures – Simple collection class that holds only the vbeProcedure type.
  3. vbeCodeModule – Ties the VBIDE.CodeModule object to a vbeProcedures collection (as well as actually creating that collection.)

The project requires references to both the Microsoft Visual Basic for Applications Extensibility 5.3 and Microsoft Access 14.0 Object libraries.

vbeCodeModule

Option Compare Database
Option Explicit

Private mCodeModule As CodeModule
Private mVbeProcedures As VbeProcedures

Public Property Get CodeModule() As CodeModule
    Set CodeModule = mCodeModule
End Property

Public Property Let CodeModule(ByRef CodeMod As CodeModule)
    Me.Initialize CodeMod
End Property

Public Property Get VbeProcedures()
    Set VbeProcedures = mVbeProcedures
End Property

Public Sub Initialize(CodeMod As CodeModule)
    Set mCodeModule = CodeMod
    Set mVbeProcedures = getProcedures(mCodeModule)
End Sub

Private Sub Class_Terminate()
    Set mVbeProcedures = Nothing
    Set mCodeModule = Nothing
End Sub

Private Function getProcedures(CodeMod As CodeModule) As VbeProcedures
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Returns collection of all vbeProcedures in a CodeModule            '
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Dim procName As String
    Dim lastProcName As String
    Dim procs As New VbeProcedures
    Dim proc As vbeProcedure

    Dim i As Long
    ' Skip past any Option statement
    '   and any module-level variable declations.

    For i = CodeMod.CountOfDeclarationLines + 1 To CodeMod.CountOfLines
        ' get procedure name
        procName = CodeMod.ProcOfLine(i, vbext_pk_Proc)
        If Not procName = lastProcName Then
            ' create new procedure object
            Set proc = New vbeProcedure
            proc.Initialize procName, CodeMod
            ' add it to collection
            procs.Add proc
            ' reset lastProcName
            lastProcName = procName
        End If
    Next i
    Set getProcedures = procs

End Function

vbeProcedures

Option Compare Database
Option Explicit

Private mCollection As Collection

Public Sub Clear()
    killVbeProcs
    Set mCollection = New Collection
End Sub

Public Function Add(ByRef vbeProc As vbeProcedure, Optional ByVal Key As Variant)
    If IsMissing(Key) Then
        mCollection.Add vbeProc
    Else
        mCollection.Add vbeProc, Key
    End If
End Function

Public Function Remove(ByVal Index As Variant)
    mCollection.Remove (Index)
End Function

Public Function Item(ByVal Index As Variant) As vbeProcedure
    Set Item = mCollection(Index)
End Function

Public Function Count() As Long
    Count = mCollection.Count
End Function

Public Function NewEnum() As IUnknown
Attribute NewEnum.VB_UserMemId = -4
    Set NewEnum = mCollection.[_NewEnum]
End Function

Private Sub Class_Initialize()
    Set mCollection = New Collection
End Sub

Private Sub Class_Terminate()
    killVbeProcs
    Set mCollection = Nothing
End Sub

Private Sub killVbeProcs()
    Dim proc As vbeProcedure
    If Not mCollection Is Nothing Then
        For Each proc In mCollection
            Set proc = Nothing
        Next proc
    End If
End Sub

vbeProcedure

Option Compare Database
Option Explicit

' error handling values
Private Const BaseErrorNum As Long = 3500

Public Enum vbeProcedureError
    vbeObjectNotIntializedError = vbObjectError + BaseErrorNum
    vbeReadOnlyPropertyError
End Enum

Private Const ObjectNotIntializedMsg = "Object Not Initialized"
Private Const ReadOnlyPropertyMsg = "Property is Read-Only after initialization"

' exposed property variables
Private mParentModule As CodeModule
Private mName As String

' truly private property variables
Private isNameSet As Boolean
Private isParentModSet As Boolean

Public Property Get Name() As String
    If isNameSet Then
        Name = mName
    Else
        RaiseObjectNotIntializedError
    End If
End Property

Public Property Let Name(ByVal vNewValue As String)
    If Not isNameSet Then
        mName = vNewValue
        isNameSet = True
    Else
        RaiseReadOnlyPropertyError
    End If
End Property

Public Property Get ParentModule() As CodeModule
    If isParentModSet Then
        Set ParentModule = mParentModule
    Else
        RaiseObjectNotIntializedError
    End If
End Property

Public Property Let ParentModule(ByRef vNewValue As CodeModule)
    If Not isParentModSet Then
        Set mParentModule = vNewValue
        isParentModSet = True
    Else
        RaiseReadOnlyPropertyError
    End If
End Property

Public Property Get startLine() As Long
    If isParentModSet And isNameSet Then
        startLine = Me.ParentModule.ProcStartLine(Me.Name, vbext_pk_Proc)
    Else
        RaiseObjectNotIntializedError
    End If
End Property

Public Property Get EndLine() As Long
    If isParentModSet And isNameSet Then
        EndLine = Me.startLine + Me.CountOfLines
    Else
        RaiseObjectNotIntializedError
    End If
End Property

Public Property Get CountOfLines() As Long
    If isParentModSet And isNameSet Then
        CountOfLines = Me.ParentModule.ProcCountLines(Me.Name, vbext_pk_Proc)
    Else
        RaiseObjectNotIntializedError
    End If
End Property

Public Sub Initialize(Name As String, CodeMod As CodeModule)
    Me.Name = Name
    Me.ParentModule = CodeMod
End Sub

Public Property Get Lines() As String
    If isParentModSet And isNameSet Then
        Lines = Me.ParentModule.Lines(Me.startLine, Me.CountOfLines)
    Else
        RaiseObjectNotIntializedError
    End If
End Property

Private Sub RaiseObjectNotIntializedError()
    Err.Raise vbeProcedureError.vbeObjectNotIntializedError, GetErrorSource, ObjectNotIntializedMsg
End Sub

Private Sub RaiseReadOnlyPropertyError()
    Err.Raise vbeProcedureError.vbeReadOnlyPropertyError, GetErrorSource, ReadOnlyPropertyMsg
End Sub

Private Function GetErrorSource() As String
    GetErrorSource = CurrentProject.Name & "." &TypeName(Me)
End Function

And finally, The example call:

Private Sub exampleCall()
On Error GoTo ErrHandler

    Dim prj As vbProject
    Set prj = VBE.ActiveVBProject

    Dim CodeMod As New vbeCodeModule
    CodeMod.Initialize prj.VBComponents("OraConfig").CodeModule
    Dim proc As vbeProcedure
    For Each proc In CodeMod.vbeProcedures
        With proc
            Debug.Print "ParentModule: " & .ParentModule.Name
            Debug.Print "Name: " & .Name
            Debug.Print "StarLine: " & .startLine
            Debug.Print "EndLine: " & .EndLine
            Debug.Print "CountOfLines: " & .CountOfLines
            'uncommenting the next line will print the procedure's contents
            'Debug.Print .Lines

            ' throw an error for fun.
            ' Sidenote, how can I expose this to vbeCodeModule, but not client code?
            .Initialize "ensureSQLNet", prj.VBComponents("OraConfig").CodeModule
        End With
    Next proc

NormalExit:
    Set CodeMod = Nothing
    Exit Sub

ErrHandler:
    If Err.number = vbeReadOnlyPropertyError Then
        MsgBox "That vbeProcedure is already initialized.", vbExclamation, "Warning"
        Resume Next
    Else
        Err.Raise Err.number, Err.Source, Err.Description, Err.HelpFile, Err.HelpContext
        Resume NormalExit:
    End If
End Sub

Solution

The only coupling I can see with MSAccess-specific is in your exampleCall (why is it Private anyway?):

Dim prj As vbProject
Set prj = VBE.ActiveVBProject

Your code works perfectly fine with Excel if you take in a VBProject parameter:

Public Sub exampleCall(project As VBProject)

If this code lives in a class module called Ext, I can then do this from the immediate pane to run the test code with Excel VBA (requires appropriate macro security settings):

set x = new Ext
x.examplecall thisworkbook.VBProject

The With block is an abuse here:

Dim proc As vbeProcedure
For Each proc In CodeMod.vbeProcedures
    With proc
        Debug.Print "ParentModule: " & .ParentModule.Name
        Debug.Print "Name: " & .Name
        Debug.Print "StarLine: " & .startLine
        Debug.Print "EndLine: " & .EndLine
        Debug.Print "CountOfLines: " & .CountOfLines
        'uncommenting the next line will print the procedure's contents
        'Debug.Print .Lines

        ' throw an error for fun.
        ' Sidenote, how can I expose this to vbeCodeModule, but not client code?
        .Initialize "ensureSQLNet", prj.VBComponents("OraConfig").CodeModule
    End With
Next proc

I don’t mean to sound rude or anything, but you’re just being lazy, it should read like this:

Dim proc As vbeProcedure
For Each proc In CodeMod.vbeProcedures
    Debug.Print "ParentModule: " & proc.ParentModule.Name
    Debug.Print "Name: " & proc.Name
    Debug.Print "StarLine: " & proc.startLine
    Debug.Print "EndLine: " & proc.EndLine
    Debug.Print "CountOfLines: " & proc.CountOfLines
    'uncommenting the next line will print the procedure's contents
    'Debug.Print proc.Lines

    ' throw an error for fun.
    ' Sidenote, how can I expose this to vbeCodeModule, but not client code?
    proc.Initialize "ensureSQLNet", prj.VBComponents("OraConfig").CodeModule

Next proc

The reason I’m saying this, is because With “holds” the reference for the instance it’s working with, which means if there’s no other reference to that instance, the Class_Terminate procedure gets called and the object is destroyed when the End With is reached. You can see this behavior in action in this post.

Using With just to do less typing (for a 4-letter identifier?) is a misuse of the keyword, in my opinion. And it gets worse when the With blocks get nested. Think of Mr. Maintainer 😉

The class names don’t follow naming conventions… but then the language itself lower-cases vb when it’s used as a prefix to anything, so I’d guess VbeCodeModule would just look weird. The ideal name would be simply CodeModule, but that forces you to fully-qualify the names:

Dim CodeMod As New VBAProject.CodeModule

Otherwise CodeModule clashes with VBE.CodeModule.

The naming convention in VB6/VBA is to use PascalCase for everything, but I find it annoying and I tend to make my local variables and parameters camelCase. I see you’re also doing that:

Dim proc As vbeProcedure

But inconsistently:

Dim CodeMod As New vbeCodeModule

Also you’re using camelCase for Private procedures and functions, which is confusing. I wouldn’t make that distinction between Private and Public, and use PascalCase for all members, regardless of their accessibility.

The vbeProcedure class desperately wants to be immutable, unfortunately unless you make the setters (letters?) Friend and compile them into their own DLL (which VBA can’t do), there’s no way this can work, so you’re stuck with settable properties that are meant to be get-only.

You’ve done well extracting the RaiseObjectNotInitializedError and RaiseReadOnlyPropertyError code into their own methods, however I’d push the DRY-ing up a step further and create a Private Sub ValidateIsInitialized() procedure whose responsibility would be to call RaiseObjectNotInitializedError when ParentModule is Nothing (no need to check for an empty name then), and then this:

Public Property Get Lines() As String
    If isParentModSet And isNameSet Then
        Lines = Me.ParentModule.Lines(Me.startLine, Me.CountOfLines)
    Else
        RaiseObjectNotIntializedError
    End If
End Property

Can turn into that:

Public Property Get Lines() As String
    ValidateIsInitialized
    Lines = Me.ParentModule.Lines(Me.StartLine, Me.CountOfLines)
End Property

The Name property setter (letter?) can simply throw an error if the new value is vbNullString, as part of regular value validation.

I’m surprised this works:

Public Property Let ParentModule(ByRef vNewValue As CodeModule)

CodeModule being an object, the property should have a setter:

Public Property Set ParentModule(ByRef vNewValue As CodeModule)

I like that you’re using a procedure attribute to enable For Each iteration:

Public Function NewEnum() As IUnknown
Attribute NewEnum.VB_UserMemId = -4
    Set NewEnum = mCollection.[_NewEnum]
End Function

…but then Item should be a parameterized, default property (with procedure attribute 0):

Attribute Item.VB_UserMemId = 0

Also hile I’m on procedure attributes, if you specify a VB_Description attribute:

Attribute Item.VB_Description = "Gets or sets the element at the specified index."

…you can get mini-documentation in the Object Browser (F2):

default property with description attribute, as it appears in the object browser

(this screenshot is forged, I used a default property from another project)

So it would look like this:

Public Property Get Item(ByVal Index As Variant) As vbeProcedure
Attribute Item.VB_Description = "Gets the procedure at the specified index."
Attribute Item.VB_UserMemId = 0
    Set Item = mCollection(Index)
End Function

Then when can do Set theFirstProcedure = CodeMod.vbeProcedures(0) 🙂

Leave a Reply

Your email address will not be published. Required fields are marked *