LISTING 2
Function MemberCode(prjName As String, _
cmpName As String, memberName As String) As String
Dim txtCode As String
Dim cmo As VBIDE.CodeModule
Dim mbr As VBIDE.Member
Dim search As String
Dim startLine As Long
Dim lineCount As Long
Dim index As Long
On Error Resume Next
' get code module reference - exit if error
Set cmo = VBInstance.VBProjects(prjName)._
VBComponents(cmpName).CodeModule
If Err Then Exit Function
' get reference to member - exit if error
Set mbr = cmo.Members(memberName)
If Err Then Exit Function
Select Case mbr.Type
Case vbext_mt_Const
search = "Const " & memberName & " "
GoSub SearchText
Case vbext_mt_Event
search = "Event " & memberName & "("
GoSub SearchText
Case vbext_mt_Method
' this can be a sub or a function or an event
startLine = cmo.ProcBodyLine(memberName, _
vbext_pk_Proc)
lineCount = cmo.ProcCountLines(memberName, _
vbext_pk_Proc)
GoSub IncludeRemarks
txtCode = cmo.Lines(startLine, lineCount)
' ATTENTION: external declares return the whole
' form-level declaration code
Case vbext_mt_Property
startLine = cmo.ProcBodyLine(memberName, vbext_pk_Get)
lineCount = cmo.ProcCountLines(memberName, _
vbext_pk_Get)
If Err = 0 Then
GoSub IncludeRemarks
txtCode = cmo.Lines(startLine, lineCount) & vbCrLf
End If
Err = 0
startLine = cmo.ProcBodyLine(memberName, vbext_pk_Let)
lineCount = cmo.ProcCountLines(memberName, _
vbext_pk_Let)
If Err = 0 Then
GoSub IncludeRemarks
txtCode = txtCode & cmo.Lines(startLine, _
lineCount) & vbCrLf
End If
Err = 0
startLine = cmo.ProcBodyLine(memberName, vbext_pk_Set)
lineCount = cmo.ProcCountLines(memberName, _
vbext_pk_Set)
If Err = 0 Then
GoSub IncludeRemarks
txtCode = txtCode & cmo.Lines(startLine, _
lineCount) & vbCrLf
End If
Case vbext_mt_Variable
search = " " & memberName & " As "
GoSub SearchText
If txtCode = "" Then
' in case there was no "As" clause
search = " " & memberName
GoSub SearchText
End If
End Select
MemberCode = txtCode
Exit Function
IncludeRemarks:
' decrease startLine while we find remarks or empty
' lines - this correction is needed because of a bug:
' ProcBodyLines returns the first executable line,
' while ProcCountLines keeps leading remarks into
' account
Do While startLine > 1
If Left$(cmo.Lines(startLine - 1, 1) & "'", 1) _
<> "'" Then Exit Do
startLine = startLine - 1
Loop
Return
SearchText:
' return the line that includes the text in
' the search variable
For index = 1 To cmo.CountOfDeclarationLines
If InStr(cmo.Lines(index, 1), search) Then
txtCode = cmo.Lines(index, 1)
Exit For
End If
Next
Return
End Function
Return to Article