The following does not exactly answer my question, but it does solve my problem. It will need to be run during development prior to publishing the application.
My workaround relies on the fact that all of my constants are named the same because I am using CPearson's code to insert the constants into my procedures during development.
The VBIDE library doesn't support procedures well, so I wrapped them up in a class module named vbeProcedure
.
' Class: vbeProcedure
' requires Microsoft Visual Basic for Applications Extensibility 5.3 library
' Author: Christopher J. McClellan
' Creative Commons Share Alike and Attribute license
' http://creativecommons.org/licenses/by-sa/3.0/
Option Compare Database
Option Explicit
Private Const vbeProcedureError As Long = 3500
Private mParentModule As CodeModule
Private isParentModSet As Boolean
Private mName As String
Private isNameSet 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 vbObjectError + vbeProcedureError + 10, CurrentProject.Name & "." & TypeName(Me), "Object Not Initialized"
End Sub
Private Sub RaiseReadOnlyPropertyError()
Err.Raise vbObjectError + vbeProcedureError + 20, CurrentProject.Name & "." & TypeName(Me), "Property is Read-Only after initialization"
End Sub
Then I added a function to my DevUtilities
module (that's important later) to create a vbeProcedure
object and return a collection of them.
Private Function getProcedures(codeMod As CodeModule) As Collection
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Returns collection of all vbeProcedures in a CodeModule '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim StartLine As Long
Dim ProcName As String
Dim lastProcName As String
Dim procs As New Collection
Dim proc As vbeProcedure
Dim i As Long
' Skip past any Option statement
' and any module-level variable declations.
StartLine = codeMod.CountOfDeclarationLines + 1
For i = StartLine 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
Next I loop through each procedure in a given code module.
Private Sub fixProcNameConstants(codeMod As CodeModule)
Dim procs As Collection
Dim proc As vbeProcedure
Dim i As Long 'line counter
'getProcName codeMod
Set procs = getProcedures(codeMod)
For Each proc In procs
With proc
' skip the proc.StartLine
For i = .StartLine + 1 To .EndLine
' find constant PROC_NAME declaration
If InStr(1, .ParentModule.Lines(i, 1), "Const PROC_NAME", vbTextCompare) Then
'Debug.Print .ParentModule.Lines(i, 1)
' replace this whole line of code with the correct declaration
.ParentModule.ReplaceLine i, "Const PROC_NAME As String = " & Chr(34) & .Name & Chr(34)
'Debug.Print .ParentModule.Lines(i, 1)
Exit For
End If
Next i
End With
Next proc
End Sub
Finally calling that sub for each code module in my active project (so long as it isn't my "DevUtilities" module).
Public Sub FixAllProcNameConstants()
Dim prj As vbProject
Set prj = VBE.ActiveVBProject
Dim codeMod As CodeModule
Dim vbComp As VBComponent
For Each vbComp In prj.VBComponents
Set codeMod = vbComp.CodeModule
' don't mess with the module that'c calling this
If Not codeMod.Name = "DevUtilities" Then
fixProcNameConstants codeMod
End If
Next vbComp
End Sub
I'll come back if I ever figure out what kind of sorcery vbWatchDog is using to expose the vba call stack.
OnError GoTo...
raises the error in calling procedure (not the procedure where error occurs, and the call stack is not exposed to you through VBA, the best I could do was to use a global string variable and assign the "active" procedure name at the start of each proc. Not perfect because a sub may call on multiple procedures before returning to error in the "main" sub (without re-assigning the string), but close enough for my needs. – MetaphaseErl
function but this requires you to explicitly number the lines – DowngradeErl
method to work. Even if I numbered the lines like999 On Error GoTo <label>
theErl
function would return999
but theCodeMod.Find()
wouldn't compute with the value999
as it literally looks at line999
instead of the one aliased999
:( – Downgrade