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 _
                            InStr(1, varLine, varTag, vbTextCompare) > 0 And _
                            InStr(1, varLine, """" & varTag & """", vbTextCompare) = 0 _
                        Then
                            strResult = strResult & Trim(Replace(varLine, varTag, "-")) & vbCrLf
                        End If
                    Next
                    
                    If strResult <> "" Then
                        strResult = Left(strResult, Len(strResult) - 1)
                        If Not blnHeader Then
                            strMsg = strMsg & vbCrLf & _
                                objVbComponent.Name & vbCrLf & _
                                String(Len(objVbComponent.Name), "=") & vbCrLf
                            blnHeader = True
                        End If
                        strMsg = strMsg & _
                            Mid(varTag, 2) & vbCrLf & _
                            String(Len(varTag), "-") & vbCrLf & _
                            strResult
                    End If
                Next
            End If
        End With
    Next
    
    Debug.Print strMsg
    MsgBox strMsg, vbOKOnly + vbInformation, "Tag Summary"
End Sub