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**
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
