Microsoft Access modDevelopment

displayCodeWhere

List all code modules and lines where the sought term occurs.

• Microsoft Visual Basic for Applications Extensibility

Sub displayCodeWhere(strWhat As String)
    Dim objVbProject As VBIDE.VBProject
    Dim objVbComponent As VBIDE.VBComponent
    Dim objCodeModule As VBIDE.CodeModule
    
    Dim strCode As String
    Dim arrLine As Variant
    Dim varLine As Variant
    Dim intLine As Integer
    Dim strResult As String
    Dim blnHeader As Boolean
    Dim blnFound As Boolean
    Dim strMsg As String
 
    Set objVbProject = Application.VBE.ActiveVBProject
    For Each objVbComponent In objVbProject.VBComponents
        Set objCodeModule = objVbComponent.CodeModule
        With objCodeModule
            
            If .CountOfLines > 0 Then
               strCode = .Lines(1, .CountOfLines)
               arrLine = Split(strCode, vbCrLf)
               intLine = 0
    
               blnHeader = False
               blnFound = False
               strResult = ""
               For Each varLine In arrLine
                   intLine = intLine + 1
                   If InStr(1, LCase(CStr(varLine)), LCase(strWhat), vbTextCompare) > 0 Then
                       
                       blnFound = True
                       If Not blnHeader Then
                           strMsg = strMsg & vbCrLf & _
                               objVbComponent.Name & vbCrLf & _
                               String(Len(objVbComponent.Name), "=") & vbCrLf
                           blnHeader = True
                       End If
                       
                       strResult = "Line " & intLine & " : " & varLine
                       strMsg = strMsg & vbCrLf & _
                           strResult
                   End If
               Next
               
               If blnFound Then
                   strMsg = strMsg & vbCrLf
               End If
            End If
        End With
    Next
    
    Debug.Print strMsg
    MsgBox strMsg, vbOKOnly + vbInformation, "Code with '" & strWhat & "'"
End Sub

displayTagSummary

Find the development tags @FIXME and @TODO and display them.

• Microsoft Visual Basic for Applications Extensibility

Sub displayTagSummary()
    Dim objVbProject As VBIDE.VBProject
    Dim objVbComponent As VBIDE.VBComponent
    Dim objCodeModule As VBIDE.CodeModule
    Dim strCode As String
    Dim arrLine As Variant
    Dim varLine As Variant
    Dim arrTag As Variant
    Dim varTag As Variant
    Dim strResult As String
    Dim blnHeader As Boolean
    Dim strMsg As String
 
    Set objVbProject = Application.VBE.ActiveVBProject
    For Each objVbComponent In objVbProject.VBComponents
        Set objCodeModule = objVbComponent.CodeModule
        With objCodeModule
            
            If .CountOfLines > 0 Then
               strCode = .Lines(1, .CountOfLines)
               arrLine = Split(strCode, vbCrLf)
    
               arrTag = Array("'@FIXME", "'@TODO")
               For Each varTag In arrTag
    
                   blnHeader = False
                   strResult = ""
                   For Each varLine In arrLine
                       If Left(varLine, Len(varTag)) = varTag Then
                           strResult = strResult & Replace(varLine, varTag, "-") & vbCrLf
                       End If
                   Next
    
                   If strResult <> "" Then
                       strResult = Left(strResult, Len(strResult) - 1)
                       If Not blnHeader Then
                           Debug.Print objVbComponent.Name
                           Debug.Print String(Len(objVbComponent.Name), "=")
                           strMsg = strMsg & objVbComponent.Name & vbCrLf & vbCrLf
                           blnHeader = True
                       End If
                       Debug.Print Mid(varTag, 2)
                       Debug.Print String(Len(varTag), "-")
                       Debug.Print strResult
                       strMsg = strMsg & _
                           Mid(varTag, 2) & vbCrLf & _
                           strResult & vbCrLf & vbCrLf
                   End If
               Next
            End If
        End With
    Next
 
    MsgBox strMsg, vbOKOnly + vbInformation, "Tag Summary"
End Sub