Log Code and Property References

[NeoPa]

Log Code and Property References

SECTION 1 - TABLE OF CONTENTS

SECTION 1 - TABLE OF CONTENTS
SECTION 2 - INTRODUCTION
SECTION 3 - TABLE LAYOUTS
SECTION 4 - CODE TO LOG CODE
SECTION 5 - CODE TO LOG PROPERTIES
SECTION 6 - IMPLEMENTATION INSTRUCTIONS
SECTION 7 - CODE TO OPEN DATABASE WITHOUT AUTOSTARTING ANY CODE

Attachment - RefLog.Zip

--------------------------------------------------------------------------------

SECTION 2 - INTRODUCTION

Have you ever needed to change a part of your project, for instance how one or more fields are designed in a table, but aren't sure which parts of your project are referencing these items? Worried that some very rarely used part of your project will be broken by the changes you're preparing? You are not alone!

Let me start by saying that MS Access has had a Documenter feature (Tools | Analyze | Documenter prior to the ribbon and Database Tools | Database Documenter afterwards.) available for many versions that can be used to provide much of the information. Unfortunately, this can be clumsy to work with and has a tendency to lose information as some text gets wrapped :-(

What I plan to introduce is a way to log all CODE into a pair of tables and all property references into a separate table. With this data available in tables you can use all sorts of display and filtering options to see what you're dealing with. A couple of queries have been included in the attached template database as examples of what can be done.

NB. The process that logs the code creates a folder (...\Macros\ relative to the current project path) if it doesn't already exist. This is deleted when the logging process has finished unless there was already one there previously.

NB. This project doesn't handle logic which is triggered by a Command Button on an old toolbar or a new ribbon. It is also possible to have routines that are only ever used by the designer who may invoke them from the Immediate Pane in the VBIDE. Thus, you may have code in the project which has no apparent references, but which is nevertheless used and important. Hopefully, in such cases, that use will be documented clearly.

--------------------------------------------------------------------------------

SECTION 3 - TABLE LAYOUTS

These tables are included in the attached databases, one of which is the BE.

Table Name=[lupControl] - Internal Access values for control types.

ControlID; Autonumber; PK
Name; String

Table Name=[lupProperty] - Properties by Type - Currently only Event properties included.

PropertyID; Autonumber; PK
PName; String
PType; String; Type of property - Event; Data; Format; Other

The two tables above contain preloaded data which is important to the workings of the project.

The tables below store the information that is gathered. They are always emptied and the BE file where they are held compacted and repaired prior to use.

Table Name=[tblProperty] - Hierarchical properties (objects).

PropID; Autonumber; PK
PParent; Numeric; Long; FK to [tblProperty]; Parent of object.  None for database.
PType; String; Database; Group; Object; Section; Control; Property.
PName; String
PVal; String

Table Name=[tblCode] - Main code items.

CodeID; Autonumber; PK
CodeType; String
CodeName; String

Table Name=[tblCodeLine] - Individual lines of code.

CodeLineID; Autonumber; PK
CodeID; Numeric; Long; FK to [tblCode]
LineNo; Numeric; Long
LineData; Memo

--------------------------------------------------------------------------------

SECTION 4 - CODE TO LOG CODE

NB. This code requires a reference to the library "Visual Basic For Applications Extensibility 5.3".

Module Name=[modExtra]

Option Compare Database
Option Explicit

'References required.
'Visual Basic For Applications Extensibility 5.3.

'Objects used across the code.
Private appAccess As Access.Application
Private dbThis As DAO.Database, dbThat As DAO.Database
Private rsVar As DAO.Recordset

'LogAll() sets dbVar from strDB and calls other procedures to log all refs.
Public Sub LogAll(strBE As String _
                , strDB As String _
                , Optional ByVal strPW As String = "")
    Dim intAttr As Integer
    Dim strMsgs As String
    Dim frmProgress As Form_frmProgress

    ' Set up and use frmProgress to show what's happening
    strMsgs = "Clearing and compacting Back-End data file.~" _
            & "Opening selected database (Set R/O first).~" _
            & "Prepare for logging of all modules, macros and queries.~" _
            & "Log all modules.~" _
            & "Log all macros.~" _
            & "Log all queries.~" _
            & "Log properties for all Forms and their objects " _
            & "(Sections, Controls, etc).~" _
            & "Log properties for all Reports and their objects " _
            & "(Sections, Controls, etc)."
    Set frmProgress = ProgressInit(strMsgs:=strMsgs, intDelSecs:=10)
    With frmProgress
        'Step 1.
        ' Clear down and compact BE DB
        Set dbThis = CurrentDb()
        With dbThis
            Call .Execute("DELETE * FROM [tblCode]", dbFailOnError)
            Call .Execute("DELETE * FROM [tblProperty]", dbFailOnError)
            Call CompactDb(strDB:=strBE)
        End With

        'Step 2.
        Call .SetStep(intStep:=2)
    End With
    ' GetAttr() fails if in Sandbox mode so we assume RO
    intAttr = vbReadOnly
    On Error Resume Next
    intAttr = GetAttr(strDB)
    On Error GoTo 0
    If (intAttr And vbReadOnly) = 0 Then _
        Call SetAttr(PathName:=strDB, Attributes:=(intAttr Or vbReadOnly))
    Set appAccess = OpenBypass(strDB:=strDB, blnExclusive:=False, strPW:=strPW)
    With appAccess
        .Visible = False
        Set dbThat = appAccess.CurrentDb()
        Call LogAllCode(frmProgress)
        Call LogProperties(frmProgress)
        Call .CloseCurrentDatabase
        Call appAccess.Quit(Option:=acQuitSaveNone)
        Set dbThat = Nothing
        Set appAccess = Nothing
    End With
    If (intAttr And vbReadOnly) = 0 Then _
        Call SetAttr(PathName:=strDB, Attributes:=intAttr)
    ' All done - Ready to close
    Call frmProgress.SetStep(intStep:=-8)
End Sub

'LogAllCode() logs all VBA, macro & SQL code into
'   tables [tblCode] & [tblCodeLine].
Public Sub LogAllCode(frmProgress As Form_frmProgress)
    Dim intFrom As Integer
    Dim lngCodeID As Long, lngLineNo As Long, lngLines As Long
    Dim strFolder As String, strTFile As String, strBuf As String
    Dim strModules As String, strWork As String, strName As String
    Dim blnFolExist As Boolean, blnStd As Boolean
    Dim varWork As Variant
    Dim aoCode As AccessObject
    Dim rsCodeLine As DAO.Recordset
    Dim qdfVar As DAO.QueryDef
    Dim colComponents As VBIDE.VBComponents
    Dim modVar As VBIDE.CodeModule

    'Step 3.
    Call frmProgress.SetStep(intStep:=3)
    strFolder = CurrentProject.Path & "\Macros\"
    blnFolExist = FolderExist(strFolder)
    If Not blnFolExist Then Call MkDir(strFolder)
    strTFile = strFolder & "Temp.Txt"
    With appAccess
        'Set up strModules for use later.
        With .VBE
            Set colComponents = IIf(.VBProjects.Count > 0 _
                                  , .ActiveVBProject.VBComponents _
                                  , Nothing)
        End With
        If Not colComponents Is Nothing Then
            With .CurrentProject
                For Each aoCode In .AllForms
                    strModules = MultiReplace("%M;Form Module,Form_%N" _
                                            , "%M", strModules _
                                            , "%N", aoCode.Name)
                Next aoCode
                For Each aoCode In .AllReports
                    strModules = MultiReplace("%M;Report Module,Report_%N" _
                                            , "%M", strModules _
                                            , "%N", aoCode.Name)
                Next aoCode
                For Each aoCode In .AllModules
                    strName = aoCode.Name
                    blnStd = (colComponents(strName).Type = vbext_ct_StdModule)
                    strWork = IIf(blnStd, "Standard", "Class")
                    strModules = MultiReplace("%M;%T Module,%N" _
                                            , "%M", strModules _
                                            , "%T", strWork _
                                            , "%N", strName)
                Next aoCode
            End With
            strModules = Mid(strModules, 2)
        End If

        'Step 4.
        Call frmProgress.SetStep(intStep:=4)
        With dbThis
            With .TableDefs("tblCodeLine")
                Set rsCodeLine = .OpenRecordset(Type:=dbOpenDynaset _
                                              , Options:=dbAppendOnly)
            End With
            With .TableDefs("tblCode").OpenRecordset(Type:=dbOpenDynaset _
                                                   , Options:=dbAppendOnly)
                For Each varWork In Split(strModules, ";")
                    strName = Split(varWork, ",")(1)
                    Call .AddNew
                    !CodeName = strName
                    !CodeType = Split(varWork, ",")(0)
                    lngCodeID = !CodeID
                    Call .Update
                    On Error Resume Next
                    Set modVar = colComponents(strName).CodeModule
                    lngLines = IIf(Err.Number = 0, modVar.CountOfLines, 0)
                    On Error GoTo 0
                    With rsCodeLine
                        For lngLineNo = 1 To lngLines
                            strBuf = modVar.Lines(StartLine:=lngLineNo _
                                                , Count:=1)
                            Call .AddNew
                            !CodeID = lngCodeID
                            !LineNo = lngLineNo
                            !LineData = IIf(strBuf = "", Null, strBuf)
                            Call .Update
                        Next lngLineNo
                    End With
                Next varWork

                'Step 5.
                Call frmProgress.SetStep(intStep:=5)
                For Each aoCode In appAccess.CurrentProject.AllMacros
                    Call .AddNew
                    !CodeName = aoCode.Name
                    !CodeType = "Macro"
                    lngCodeID = !CodeID
                    Call .Update
                    ' For ACCDB files this command exports the data as Unicode.
                    ' It sometimes fails due to being called too soon.
                    On Error Resume Next
                    Do
                        If Err > 0 Then DoEvents
                        Call Err.Clear
                        Call appAccess.SaveAsText(ObjectType:=acMacro _
                                                , ObjectName:=aoCode.Name _
                                                , FileName:=strTFile)
                    Loop Until Err = 0
                    On Error GoTo 0
                    lngLineNo = 0
                    intFrom = FreeFile()
                    Open strTFile For Input Access Read Lock Write As #intFrom
                    strBuf = Input(2, #intFrom)
                    'Unicode files (from ACCDB) start with FF FE.
                    If strBuf <> Chr(&HFF) & Chr(&HFE) Then Seek #intFrom, 1
                    With rsCodeLine
                        Do Until EOF(intFrom)
                            lngLineNo = lngLineNo + 1
                            Line Input #intFrom, strBuf
                            Call .AddNew
                            !CodeID = lngCodeID
                            !LineNo = lngLineNo
                            !LineData = IIf(strBuf = "", Null, strBuf)
                            Call .Update
                        Loop
                        Close #intFrom
                    End With
                    Call KillFile(strFile:=strTFile, blnIgnore:=True)
                Next aoCode

                'Step 6.
                Call frmProgress.SetStep(intStep:=6)
                For Each qdfVar In dbThat.QueryDefs
                    Call .AddNew
                    !CodeName = qdfVar.Name
                    !CodeType = "QueryDef"
                    lngCodeID = !CodeID
                    Call .Update
                    strWork = GetSQL(strQuery:=qdfVar.Name, dbVar:=dbThat)
                    Do While Right(strWork, 2) = vbNewLine
                        strWork = Left(strWork, Len(strWork) - 2)
                    Loop
                    With rsCodeLine
                        lngLineNo = 0
                        For Each varWork In Split(strWork, vbNewLine)
                            strBuf = varWork
                            lngLineNo = lngLineNo + 1
                            Call .AddNew
                            !CodeID = lngCodeID
                            !LineNo = lngLineNo
                            !LineData = IIf(strBuf = "", Null, strBuf)
                            Call .Update
                        Next varWork
                    End With
                Next qdfVar
                Call .Close
            End With
            Call rsCodeLine.Close
            Set rsCodeLine = Nothing
            If Exist(strTFile) Then _
                Call KillFile(strFile:=strTFile, blnIgnore:=True)
            If Not blnFolExist Then Call RmDir(strFolder)
        End With
    End With
End Sub

As you'll see, there is a fair bit of code involved so I'll limit this to a general explanation of what happens to log the code here.

LogAllCode() is the main procedure for logging code. It handles the VBA code by accessing the VBIDE (Visual Basic for Applications Integrated Development Environment) and examining each line of code referenced there. This works for standard as well as class and object (Forms / Reports) modules. As well as the VBA code there are also Macros and QueryDefs to look at.

Macros are handled by using SaveAsText() to save a text version of the macro to a file. This file is then read in and saved into the table.

QueryDefs are interesting as they cover not just those created by the designer manually but also many that are created automatically for you whenever you create any SQL in your forms or reports. The QueryDefs collection thus brings together all SQL stored in the project apart from any created on the fly using VBA code. This is very useful for finding all references. A QueryDef has a .SQL property which is queried using GetSQL() (See Access QueryDefs Mis-save Subquery SQL for why it isn't used directly). This string is then split by line and saved in the table.

--------------------------------------------------------------------------------

SECTION 5 - CODE TO LOG PROPERTIES

See previous section for the first part of the module. This code follows on from that in the same module (modExtra).

'LogProperties() loads (into [tblProperty]) all the Form & Report objects and
'   their event properties.
Public Sub LogProperties(frmProgress As Form_frmProgress _
                       , Optional strPropType As String = "Event")
    Dim lngDB As Long, lngGroup As Long, lngObject As Long, lngSection As Long
    Dim lngX As Long
    Dim strName As String
    Dim blnOpen As Boolean
    Dim objVar As Object
    Dim aoVar As AccessObject
    Dim sctVar As Section
    Dim ctlVar As Control

    'Step 7.
    Call frmProgress.SetStep(intStep:=7)
    With appAccess.CurrentProject
        Set rsVar = dbThis.OpenRecordset(Name:="tblProperty" _
                                       , Type:=dbOpenDynaset _
                                       , Options:=dbDenyWrite)
        strName = .Name
        With rsVar
            Call .AddNew
            !PType = "Database"
            !PName = strName
            lngDB = !PropID
            Call .Update
            Call .AddNew
            !PParent = lngDB
            !PType = "Group"
            !PName = "Forms"
            lngGroup = !PropID
            Call .Update
        End With
        For Each aoVar In .AllForms
            strName = aoVar.Name
            With appAccess
                blnOpen = IsOpen(strName, acForm)
                If Not blnOpen Then _
                    Call .DoCmd.OpenForm(FormName:=strName _
                                       , View:=acDesign _
                                       , WindowMode:=acHidden)
                Set objVar = .Forms(strName)
            End With
            lngObject = LoadRefs(objVar:=objVar _
                               , lngParent:=lngGroup _
                               , strPropType:=strPropType)
            For lngX = acDetail To acPageFooter
                'Horribly kludgy interface with Sections :-(
                On Error Resume Next
                Set sctVar = Nothing
                Set sctVar = objVar.Section(lngX)
                On Error GoTo 0
                If Not sctVar Is Nothing Then
                    lngSection = LoadRefs(objVar:=sctVar, lngParent:=lngObject)
                    For Each ctlVar In sctVar.Controls
                        Call LoadRefs(objVar:=ctlVar, lngParent:=lngSection)
                    Next ctlVar
                End If
            Next lngX
            If Not blnOpen Then _
                Call appAccess.DoCmd.Close(ObjectType:=acForm _
                                         , ObjectName:=strName _
                                         , Save:=acSaveNo)
        Next aoVar
        With rsVar
            Call .AddNew
            !PParent = lngDB
            !PType = "Group"
            !PName = "Reports"
            lngGroup = !PropID
            Call .Update
        End With

        'Step 8.
        Call frmProgress.SetStep(intStep:=8)
        For Each aoVar In .AllReports
            strName = aoVar.Name
            With appAccess
                blnOpen = IsOpen(strName, acReport)
                If Not blnOpen Then _
                    Call .DoCmd.OpenReport(ReportName:=strName _
                                         , View:=acDesign _
                                         , WindowMode:=acHidden)
                Set objVar = .Reports(strName)
            End With
            lngObject = LoadRefs(objVar:=objVar, lngParent:=lngGroup)
            For lngX = acDetail To 9999
                'Horribly kludgy interface with Sections :-(
                On Error Resume Next
                Set sctVar = Nothing
                Set sctVar = objVar.Section(lngX)
                On Error GoTo 0
                If sctVar Is Nothing Then
                    If lngX > acPageFooter Then Exit For
                Else
                    lngSection = LoadRefs(objVar:=sctVar, lngParent:=lngObject)
                    For Each ctlVar In sctVar.Controls
                        Call LoadRefs(objVar:=ctlVar, lngParent:=lngSection)
                    Next ctlVar
                End If
            Next lngX
            If Not blnOpen Then _
                Call appAccess.DoCmd.Close(ObjectType:=acReport _
                                         , ObjectName:=strName _
                                         , Save:=acSaveNo)
        Next aoVar
        Call rsVar.Close
        Set rsVar = Nothing
    End With
End Sub

'LoadRefs() loads (into [tblProperty]) all the properties and sub-properties of
'   the objVar.
'   If strPropType is passsed then only handles properties of that type.
Private Function LoadRefs(objVar As Object _
                        , ByVal lngParent As Long _
                        , Optional ByVal strPropType As String = "All") As Long
    Static strValid As String
    Dim strSQL As String, strPType As String, strPName As String
    Dim prpVar As DAO.Property

    If strValid = "" Then
        If strPType = "All" Then
            strSQL = "lupProperty"
        Else
            strSQL = MultiReplace("SELECT *%L" _
                                & "FROM   [lupProperty]%L" _
                                & "WHERE  ([PType]='%T')" _
                                , "%T", strPropType _
                                , "%L", vbNewLine)
        End If
        strValid = ","
        With dbThis.OpenRecordset(Name:=strSQL, Type:=dbOpenSnapshot)
            Do Until .EOF
                strValid = strValid & !PName & ","
                Call .MoveNext
            Loop
            Call .Close
        End With
    End If
    Select Case True
    Case TypeOf objVar Is Form
        strPType = "Form"
    Case TypeOf objVar Is Report
        strPType = "Report"
    Case TypeOf objVar Is Section
        strPType = "Section"
    Case TypeOf objVar Is Control
        strPType = "Control"
    End Select
    With rsVar
        Call .AddNew
        !PParent = lngParent
        !PType = strPType
        !PName = objVar.Name
        lngParent = !PropID
        Call .Update
        LoadRefs = lngParent
    End With
    For Each prpVar In objVar.Properties
        strPName = prpVar.Name
        If InStr(strValid, "," & strPName & ",") > 0 Then
            If prpVar.Value > "" Then
                With rsVar
                    Call .AddNew
                    !PParent = lngParent
                    !PType = "Property"
                    !PName = strPName
                    !PVal = prpVar.Value
                    Call .Update
                End With
            End If
        End If
    Next prpVar
End Function

'IsOpen() returns true if strName is an open object.
'Redo using appAccess.
Public Function IsOpen(strName As String, lngType As Long) As Boolean
    Dim objColl As Object, objVar As Object

    With appAccess
        Select Case lngType
        Case acForm
            Set objColl = .Forms
        Case acReport
            Set objColl = .Reports
        End Select
        For Each objVar In objColl
            If strName = objVar.Name Then
                IsOpen = True
                Exit Function
            End If
        Next objVar
    End With
End Function

LogProperties() is the main procedure for logging properties. It handles object types from the main database down to the properties of a control. The code is called recursively to log the structure and displayed in qryProperty with the full hierarchy. Form and Report objects have Sections and Controls and all of these have Properties.

Properties are important as they can indicate where code and macros are invoked. If you want to identify items that are no longer used in the project, for instance, having a table of all event references can prove invaluable.

--------------------------------------------------------------------------------

SECTION 6 - IMPLEMENTATION & USAGE INSTRUCTIONS

To experiment with this simply download the file, extract the databases into a folder (both together) and run RefLog.Accdb. You'll see a basic illustration of what it can do and what information is made available to you.

To utilise this functionality on your own database browse to your database file and then enter its password if it has one. Depending on the size of your project the logging process can take minutes or hours. I have a very large and complex database with many hundreds of objects and it took twenty minutes to complete. A more straightforward database of mine took a couple. However long it takes, there is a progress form which indicates whereabout you are within the process.

When all the data has been logged show the two queries from the main form. I suggest you maximise them to give optimum viewing. After that you can use standard searching and filtering to show just the lines you're interested in.

--------------------------------------------------------------------------------

SECTION 7 - CODE TO OPEN DATABASE WITHOUT AUTOSTARTING ANY CODE

One very important part of this project is the OpenBypass() procedure to open a database as the CurrentDb without allowing any autostarting code to run. Equivalent to holding down the Shift or Bypass key. This is accomplished using the code below and is discussed in depth in my video Access Open Bypass (cc):

Module Name=[OpenBypass]

Option Compare Database
Option Explicit

'Windows API Variable Prefixes
'cb = Count of Bytes (32-bit)
'w  = Word (16-bit)
'dw = Double Word (32-bit)
'lp = Long Pointer (32-bit)
'b  = Boolean (32-bit)
'h  = Handle (32-bit)
'ul = Unsigned Long (32-bit)

Private Const conShift As Integer = &H10

Private Declare Function GetKeyboardState Lib "user32" _
                            (ByRef abytKeys As Byte) As Long
Private Declare Function SetKeyboardState Lib "user32" _
                            (ByRef abytKeys As Byte) As Long
Private Declare Function SetForegroundWindow Lib "user32" _
                            (ByVal lngWnd As Long) As Long
Private Declare Function SetFocus Lib "user32" _
                            (ByVal lngWnd As Long) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" _
                            (ByVal lngWnd As Long _
                           , ByRef lngProcessId As Long) As Long
Private Declare Function AttachThreadInput Lib "user32" _
                            (ByVal lngIDAttach As Long _
                           , ByVal lngIDAttachTo As Long _
                           , ByVal lngAttach As Long) As Long

'OpenBypass() creates a new instance of Access and opens strDB (using strPW
'   if passed) without any auto-start features triggered (AutoExec macro or
'   Startup form/page).
'   It returns the new Access application.
Public Function OpenBypass(ByVal strDB As String _
                         , Optional blnExclusive As Boolean = False _
                         , Optional strPW As String = "") _
                           As Access.Application
    Dim lngThis As Long, lngThat As Long
    Dim abytKeys(0 To 255) As Byte, bytVar As Byte

    ' Create new automation instance of Access
    Set OpenBypass = CreateObject("Access.Application")
    With OpenBypass
        .Visible = True
        ' Attach to process
        lngThis = GetWindowThreadProcessId(hWndAccessApp, ByVal 0)
        lngThat = GetWindowThreadProcessId(.hWndAccessApp, ByVal 0)
        Call AttachThreadInput(lngThis, lngThat, True)
        ' First give new application focus
        Call SetForegroundWindow(.hWndAccessApp)
        Call SetFocus(.hWndAccessApp)
        ' Set Shift state
        Call GetKeyboardState(abytKeys(0))
        bytVar = abytKeys(conShift)
        abytKeys(conShift) = &H80
        Call SetKeyboardState(abytKeys(0))
        ' Open strDB with auto-start features disabled
        Call .OpenCurrentDatabase(Filepath:=strDB _
                                , Exclusive:=blnExclusive _
                                , bstrPassword:=strPW)
        ' Revert keyboard state
        abytKeys(conShift) = bytVar
        Call SetKeyboardState(abytKeys(0))
        ' Detach threads
        Call AttachThreadInput(lngThis, lngThat, False)
    End With
End Function

--------------------------------------------------------------------------------

[jimatqsi]

This will be very useful, both for its functionality and also as a reference for how to code some things. I've never cruised through the VBA code before.

Thanks!

Jim

[NeoPa]

This article has now been revised with a new version (attached to OP in place of the original) which :

1. Runs as a separate project. No longer needs to be integrated into an existing one.
2. Handles DB passwords for the DB to be loaded.
3. Shows a progress window while the logging is in progress.
4. Handles bypassing the automatic startup options of the DB being logged.

I strongly recommend downloading the new version even if you have a copy of the old.

[twinnyfo]

NeoPa,

This will be incredibly helpful to me! Not only for those minor changes that affect my entire DB, but also to assist in documentation. I, too, have suffered the effects of Access loosing data in its documenter!

Thanks for this awesome tool!

[NeoPa]

Hi Twinnyfo.

If you're interested in documentation then one of our members here (and a friend of mine - strive4peace) has knocked something up recently I believe you may be interested in -
Crystal's Code Documenter.

[NeoPa]

Updated to include the OpenBypass() code to coincide with the video I just published explaining how that works - Access Open Bypass (cc).

Many thanks are due, again, to Crystal (strive4peace). An Access MVP of very long standing and a friend.