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.
Expand|Select|Wrap|Line Numbers
- ControlID; Autonumber; PK
- Name; String
Expand|Select|Wrap|Line Numbers
- PropertyID; Autonumber; PK
- PName; String
- PType; String; Type of property - Event; Data; Format; Other
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).
Expand|Select|Wrap|Line Numbers
- 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
Expand|Select|Wrap|Line Numbers
- CodeID; Autonumber; PK
- CodeType; String
- CodeName; String
Expand|Select|Wrap|Line Numbers
- 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]
Expand|Select|Wrap|Line Numbers
- 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
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).
Expand|Select|Wrap|Line Numbers
- '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
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]
Expand|Select|Wrap|Line Numbers
- 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