以下内容并不能完全回答我的问题,但确实解决了我的问题。它需要在发布应用程序之前的开发过程中运行。
我的解决方法依赖于我的所有常量都被命名为相同的事实,因为我在开发过程中使用CPearson's code 将常量插入到我的过程中。
VBIDE 库不能很好地支持过程,所以我将它们封装在一个名为 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
然后我向我的DevUtilities 模块(稍后很重要)添加了一个函数来创建一个vbeProcedure 对象并返回它们的集合。
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
接下来我遍历给定代码模块中的每个过程。
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
最后为我的活动项目中的每个代码模块调用该子程序(只要它不是我的“DevUtilities”模块)。
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
如果我弄清楚 vbWatchDog 使用哪种魔法来暴露 vba 调用堆栈,我会回来的。