Microsoft Access modDevelopment

It could happen that you receive run time error 50289 "Can't perform operation since the project is protected". It seems that if a project is protected is deliberately not allowed to manipulate VBProjects. The only way to avoid this from appearing is to unprotect the project containing the code first.

displayCodeWhere

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

• Microsoft Visual Basic for Applications Extensibility

Public 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

Public 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 objVbProject In Application.VBE.VBProjects
        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, LCase(varLine), LCase(varTag), vbTextCompare) > 0 And _
                            InStr(1, LCase(varLine), LCase("""" & 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
                               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
    'Next
 
    MsgBox strMsg, vbOKOnly + vbInformation, "Tag Summary"
End Sub