This page describes how to use VBA code to insert procedure
names into other VBA code.
In VBA, there is no way to determine programmatically the name of the currently
running procedure. That is, there is no way
for a procedure to get its own name. Such a feature would be very useful when
generating debug and diagnostic reports. This
page describes a VBA procedure that you can use to insert
Const declarations in your procedures which have
a value equal to the procedure name.
This page assumes you are familiar, at least at the conceptual level, of using
code to manipulate other code. This topic is covered
in some detail on the Programming The VBA Editor page. I
suggest that you read that page first, before using
the code on this page.
The value of the constant inserted in to each procedure is set automatically to
the name of the procedure in which it is inserted.
When you run the code, you will be prompted for the name of the constant that
will be used, such as C_PROC_NAME.
The code will insert a line of code like:
The code automatically handles several details in determining where in
the procedure to insert the constant declaration. First, it
properly accounts for parameter declarations that span more than one line of
text. E.g.,
Const C_PROC_NAME = "BBB"
Note here that the constant is inserted after the comment block that
follows immediately
after then procedure declaration.
The code also supports replacing existing constant statements with the
new constant statements. If a procedure has a constant
declared with the same name that you entered at the InputBox prompt,
that constant declaration will be
removed and replaced with the new constant declaration.
See the VBE Menus page on this site for
information about how to add this procedure to
a menu in the Visual Basic Editor. You can
download a bas file
containing the code below. The complete VBA code is shown below.
Private Const C_MSGBOX_TITLE = "Insert Procedure
Names"
Private Const C_VBE_CONST_TAG =
"__INSERTCONSTLINE__"
Private Const C_VBE_INSERT_MENU As Long = 30005
Sub InsertProcedureNameIntoProcedures()
Const C_PROC_NAME =
"InsertProcedureNameIntoProcedure"
Dim ProcName As String
Dim ProcLine As String
Dim ProcType As VBIDE.vbext_ProcKind
Dim StartLine As Long
Dim Msg As String
Dim VBComp As VBIDE.VBComponent
Dim CodeMod As VBIDE.CodeModule
Dim Ndx As Long
Dim Res As Variant
Dim Done As Boolean
Dim ProcBodyLine As Long
Dim SaveProcName As String
Dim ConstName As String
Dim ValidConstName As Boolean
Dim ConstAtLine As Long
Dim EndOfDeclaration As Long
If Application.VBE.ActiveVBProject Is Nothing Then
MsgBox "There is no active project.", vbOKOnly,
C_MSGBOX_TITLE
Exit Sub
End If
If Application.VBE.ActiveVBProject.Protection =
vbext_pp_locked Then
MsgBox "The active project is locked.",
vbOKOnly, C_MSGBOX_TITLE
Exit Sub
End If
If Application.VBE.ActiveCodePane Is Nothing Then
MsgBox "There is no active code pane.",
vbOKOnly, C_MSGBOX_TITLE
Exit Sub
End If
ConstName = InputBox(prompt:="Enter a constant name
(e.g. 'C_PROC_NAME')
that will be used as " & vbCrLf & _
"the constant in which to store the procedure
name.",
Title:=C_MSGBOX_TITLE)
If Trim(ConstName) = vbNullString Then
Exit Sub
End If
If IsValidConstantName(ConstName) = False Then
MsgBox "The constant name: '" & ConstName
&
"' is invalid.", vbOKOnly, C_MSGBOX_TITLE
Exit Sub
End If
Set CodeMod =
Application.VBE.ActiveCodePane.CodeModule
StartLine = CodeMod.CountOfDeclarationLines + 1
ProcName = CodeMod.ProcOfLine(StartLine, ProcType)
SaveProcName = ProcName
Do Until Done
ProcBodyLine = CodeMod.ProcBodyLine(ProcName,
ProcType)
ConstAtLine = ConstNameInProcedure(ConstName,
CodeMod,
ProcName, ProcType)
If ConstAtLine > 0 Then
CodeMod.DeleteLines ConstAtLine, 1
CodeMod.InsertLines ConstAtLine,
"CONST
" & ConstName & " = " & Chr(34) & ProcName & Chr(34)
Else
EndOfDeclaration =
EndOfDeclarationLines(CodeMod,
ProcName, ProcType)
ProcLine =
EndOfCommentOfProc(CodeMod,
EndOfDeclaration + 1)
CodeMod.InsertLines ProcLine + 1,
"CONST
" & ConstName & " = " & Chr(34) & ProcName & Chr(34)
End If
StartLine = ProcBodyLine +
CodeMod.ProcCountLines(ProcName,
ProcType) + 1
ProcName = CodeMod.ProcOfLine(StartLine,
ProcType)
If ProcName = SaveProcName Then
Done = True
Else
SaveProcName = ProcName
End If
Loop
End Sub
Function EndOfCommentOfProc(CodeMod As
VBIDE.CodeModule, ProcBodyLine
As Long) As Long
Dim Done As Boolean
Dim LineNum As String
Dim LineText As String
LineNum = ProcBodyLine
Do Until Done
LineNum = LineNum + 1
LineText = CodeMod.Lines(LineNum, 1)
If Left(Trim(LineText), 1) = "'" Then
Done = False
Else
Done = True
End If
Loop
EndOfCommentOfProc = LineNum - 1
End Function
Function IsValidConstantName(ConstName As String) As
Boolean
Const C_PROC_NAME = "IsValidConstantName"
Dim C As String
Dim N As Long
Dim CAsc As Integer
If InStr(1, ConstName, " ") > 0 Then
IsValidConstantName = False
Exit Function
End If
If IsNumeric(Left(ConstName, 1)) = True Then
IsValidConstantName = False
Exit Function
End If
For N = 2 To Len(ConstName)
C = Mid(ConstName, N, 1)
CAsc = Asc(C)
Select Case CAsc
Case Asc("A") To Asc("Z")
Case Asc("0") To Asc("9")
Case Asc("_")
Case Else
IsValidConstantName = False
Exit Function
End Select
Next N
IsValidConstantName = True
End Function
Function ConstNameInProcedure(ConstName As String,
CodeMod As VBIDE.CodeModule,
_
ProcName As String, _
ProcType As VBIDE.vbext_ProcKind) As Long
Const C_PROC_NAME = "ConstNameInProcedure"
Dim LineNum As Long
Dim LineText As String
Dim ProcBodyLine As Long
ProcBodyLine = CodeMod.ProcBodyLine(ProcName,
ProcType)
For LineNum = ProcBodyLine To ProcBodyLine +
CodeMod.ProcCountLines(ProcName,
ProcType)
LineText = CodeMod.Lines(LineNum, 1)
If InStr(LineText, " " & ConstName & " ")
>
0 Then
ConstNameInProcedure = LineNum
Exit Function
End If
Next LineNum
End Function
Function EndOfDeclarationLines(CodeMod As
VBIDE.CodeModule, ProcName
As String, _
ProcType As VBIDE.vbext_ProcKind) As Long
Const C_PROC_NAME = "EndOfDeclarationLines"
Dim LineNum As Long
Dim LineText As String
LineNum = CodeMod.ProcBodyLine(ProcName, ProcType)
Do Until Right(CodeMod.Lines(LineNum, 1), 1) <> "_"
LineNum = LineNum + 1
Loop
EndOfDeclarationLines = LineNum
End Function
This page last modified: 3-July-2007.