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