Extending the VBA Extensibility Library

Question

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

Answer 1

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

Dim prj As vbProject
Set prj = VBE.ActiveVBProject

Your code works perfectly fine with Excel vba 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) :)

• RubberDuck: Great review. I'd upvote twice if I could. Quick question. In vbeProcedure the Property Get EndLine.. Is it proper to use the keyword Me there?
• Mathieu Guindon: I hardly ever use Me - pretty much like this in C#, I tend to only use it when I need a reference to the current instance of the type, like in TypeName(Me), or if a method returns Me; any other usage is, I find, redundant. But that probably falls under personal preference.
• RubberDuck: Interesting fact about the ParentModule property. If I change it to Set, the code breaks. It seems to be a side effect of my use of Me. I'll have to think about that on my next version.