How to identify orphan variable/functions? (1 Viewer)

amorosik

Member
Local time
Today, 09:30
Joined
Apr 18, 2020
Messages
390
I have a procedure created with Microsoft Access 2013
I would like to create a system to identify and eliminate orphan variable and functions, i.e. those that have been defined but are not used anywhere in the program
So, once you have identified a variable/function, how would you do to understand if it is used in other forms, modules, reports, queries?
(I mean without scanning the contents of all forms, reports, forms, queries every time)
 

amorosik

Member
Local time
Today, 09:30
Joined
Apr 18, 2020
Messages
390
Use the Total Search in V-tools.

Thanks for the advice
I am trying to use it
But I don't see where features are provided for detecting orphan variables / functions
Do you know the tool and do you know for sure that it is possible to highlight variables and orphan functions?
 

sonic8

AWF VIP
Local time
Today, 09:30
Joined
Oct 27, 2015
Messages
998
But I don't see where features are provided for detecting orphan variables / functions
Do you know the tool and do you know for sure that it is possible to highlight variables and orphan functions?
There is no tool available that will directly highlight unused VBA functions and variables.
There are a couple of tools available that support you identifying such unused VBA elements by searching the whole Access project for them. The before-mentioned V-Tools is probably the best free tool available, there also are commercial tools like Total Access Analyzer and Find and Replace (I'm it's co-owner) that are more sophisticated but basically do the same thing.

If you would be just focusing on pure VBA, the best tool would be MZ-Tools, which also has a dedicated feature to identify "dead code". However MZ-Tools only analyzes VBA code but not expressions in the Access objects. So, it is not ideal for this particular purpose.
 

Pat Hartman

Super Moderator
Staff member
Local time
Today, 03:30
Joined
Feb 19, 2002
Messages
43,263
Take a look at Total Access Analyzer from FMS at www.FMSINC.com

It is a very useful tool and your employer will probably pay for it if you can't. It has a report that identifies unused objects.
 

amorosik

Member
Local time
Today, 09:30
Joined
Apr 18, 2020
Messages
390
There is no tool available that will directly highlight unused VBA functions and variables.
There are a couple of tools available that support you identifying such unused VBA elements by searching the whole Access project for them. The before-mentioned V-Tools is probably the best free tool available, there also are commercial tools like Total Access Analyzer and Find and Replace (I'm it's co-owner) that are more sophisticated but basically do the same thing.

If you would be just focusing on pure VBA, the best tool would be MZ-Tools, which also has a dedicated feature to identify "dead code". However MZ-Tools only analyzes VBA code but not expressions in the Access objects. So, it is not ideal for this particular purpose.

Yes, I also use MzTools and I know the function
But I would like to create a procedure that would obtain the same functions both to understand how to do it and to have full control and adapt it better to my needs.
 

amorosik

Member
Local time
Today, 09:30
Joined
Apr 18, 2020
Messages
390
Take a look at Total Access Analyzer from FMS at www.FMSINC.com

It is a very useful tool and your employer will probably pay for it if you can't. It has a report that identifies unused objects.

Yes thanks
As I wrote above I already have MzTools which includes a similar functionality
But I would like to develop my procedure both to understand how it works and to have full control over it
 

theDBguy

I’m here to help
Staff member
Local time
Today, 00:30
Joined
Oct 29, 2018
Messages
21,467
But I would like to create a procedure that would obtain the same functions both to understand how to do it and to have full control and adapt it better to my needs.
Hi. If you have already started creating your procedure and need help finishing it, please post what you have so far, so we can take a look and help you fix any problems. Please describe what is not working with your procedure, so we can tell you how to fix it.
 

amorosik

Member
Local time
Today, 09:30
Joined
Apr 18, 2020
Messages
390
Hi. If you have already started creating your procedure and need help finishing it, please post what you have so far, so we can take a look and help you fix any problems. Please describe what is not working with your procedure, so we can tell you how to fix it.

Yes, of course
I'm looking at this code to read and export forms, report, query, tabledef objects to text file
I thought of using it to acquire all the objects contained in a procedure and feed a table that would allow you to quickly search for information
Once the initial analysis was performed, the table would contain all the information needed to highlight the orphaned variables / functions / sub
It remains to understand how to proceed with the cancellation from the present code
 

MajP

You've got your good things, and you've got mine.
Local time
Today, 03:30
Joined
May 21, 2018
Messages
8,527
I'm looking at this code to read and export forms, report, query, tabledef objects to text file

Code:
Public Sub DocDatabase()
 '====================================================================
 ' Name:    DocDatabase
 ' Purpose: Documents the database to a series of text files
 '
 ' Author:  Arvin Meyer
 ' Date:    June 02, 1999
 ' Comment: Uses the undocumented [Application.SaveAsText] syntax
 '            To reload use the syntax [Application.LoadFromText]
 '        Modified to set a reference to DAO 8/22/2005
 '====================================================================
On Error GoTo Err_DocDatabase
Dim dbs As DAO.Database
Dim cnt As DAO.Container
Dim doc As DAO.Document
Dim i As Integer

Set dbs = CurrentDb() ' use CurrentDb() to refresh Collections

Set cnt = dbs.Containers("Forms")
For Each doc In cnt.Documents
    Application.SaveAsText acForm, doc.Name, "D:\Document\" & doc.Name & ".txt"
Next doc

Set cnt = dbs.Containers("Reports")
For Each doc In cnt.Documents
    Application.SaveAsText acReport, doc.Name, "D:\Document\" & doc.Name & ".txt"
Next doc

Set cnt = dbs.Containers("Scripts")
For Each doc In cnt.Documents
    Application.SaveAsText acMacro, doc.Name, "D:\Document\" & doc.Name & ".txt"
Next doc

Set cnt = dbs.Containers("Modules")
For Each doc In cnt.Documents
    Application.SaveAsText acModule, doc.Name, "D:\Document\" & doc.Name & ".txt"
Next doc

For i = 0 To dbs.QueryDefs.Count - 1
    Application.SaveAsText acQuery, dbs.QueryDefs(i).Name, "D:\Document\" & dbs.QueryDefs(i).Name & ".txt"
Next i

Set doc = Nothing
Set cnt = Nothing
Set dbs = Nothing

Exit_DocDatabase:
    Exit Sub


Err_DocDatabase:
    Select Case Err

    Case Else
        MsgBox Err.Description
        Resume Exit_DocDatabase
    End Select

End Sub
 

amorosik

Member
Local time
Today, 09:30
Joined
Apr 18, 2020
Messages
390
Code:
Public Sub DocDatabase()
'====================================================================
' Name:    DocDatabase
' Purpose: Documents the database to a series of text files
'
' Author:  Arvin Meyer
' Date:    June 02, 1999
' Comment: Uses the undocumented [Application.SaveAsText] syntax
'            To reload use the syntax [Application.LoadFromText]
'        Modified to set a reference to DAO 8/22/2005
'====================================================================
On Error GoTo Err_DocDatabase
Dim dbs As DAO.Database
Dim cnt As DAO.Container
Dim doc As DAO.Document
Dim i As Integer

Set dbs = CurrentDb() ' use CurrentDb() to refresh Collections

Set cnt = dbs.Containers("Forms")
For Each doc In cnt.Documents
    Application.SaveAsText acForm, doc.Name, "D:\Document\" & doc.Name & ".txt"
Next doc

Set cnt = dbs.Containers("Reports")
For Each doc In cnt.Documents
    Application.SaveAsText acReport, doc.Name, "D:\Document\" & doc.Name & ".txt"
Next doc

Set cnt = dbs.Containers("Scripts")
For Each doc In cnt.Documents
    Application.SaveAsText acMacro, doc.Name, "D:\Document\" & doc.Name & ".txt"
Next doc

Set cnt = dbs.Containers("Modules")
For Each doc In cnt.Documents
    Application.SaveAsText acModule, doc.Name, "D:\Document\" & doc.Name & ".txt"
Next doc

For i = 0 To dbs.QueryDefs.Count - 1
    Application.SaveAsText acQuery, dbs.QueryDefs(i).Name, "D:\Document\" & dbs.QueryDefs(i).Name & ".txt"
Next i

Set doc = Nothing
Set cnt = Nothing
Set dbs = Nothing

Exit_DocDatabase:
    Exit Sub


Err_DocDatabase:
    Select Case Err

    Case Else
        MsgBox Err.Description
        Resume Exit_DocDatabase
    End Select

End Sub

Thank you very much, the code listed is really useful to me
What about sub/functions within a form / module / report?
I mean, from vba code how to go about listing them?
Or maybe the only way is to parse the produced text file?
 

Pat Hartman

Super Moderator
Staff member
Local time
Today, 03:30
Joined
Feb 19, 2002
Messages
43,263
The individual procedures are not objects so you will need to parse the text yourself.
 

isladogs

MVP / VIP
Local time
Today, 08:30
Joined
Jan 14, 2017
Messages
18,216
This is one of the items in the link given by @MajP to Chip Pearson's excellent article

Code:
'######################
'Listing All Procedures In A Module
'This code will list all the procedures in the named module
'For example ListProcedures("modVBECode")

Sub ListProcedures(strModule As String)
  
On Error GoTo Err_Handler
        Dim VBAEditor As VBIDE.VBE
        Dim VBProj As VBIDE.VBProject
        Dim VBComp As VBIDE.VBComponent
        Dim CodeMod As VBIDE.CodeModule
        Dim LineNum As Long
        Dim NumLines As Long
        Dim ProcName As String
        Dim ProcKind As VBIDE.vbext_ProcKind
      
        Set VBAEditor = Application.VBE
        Set VBProj = VBAEditor.ActiveVBProject
        Set VBComp = VBProj.VBComponents(strModule)
        Set CodeMod = VBComp.CodeModule
    
        With CodeMod
            LineNum = .CountOfDeclarationLines + 1
            Do Until LineNum >= .CountOfLines
                ProcName = .ProcOfLine(LineNum, ProcKind)
                LineNum = .ProcStartLine(ProcName, ProcKind) + _
                        .ProcCountLines(ProcName, ProcKind) + 1
              Debug.Print ProcName
            Loop
        End With
      
Exit_Handler:
        Exit Sub
      
Err_Handler:
    If Err = 9 Then
        MsgBox "Module does not exist", vbCritical, "No such module"
    Else
        MsgBox "Error " & Err.number & " in ListProcedures : " & Err.description
    End If
    GoTo Exit_Handler
  
End Sub

and I wrote this code based on the above which lists all procedures in each code module

Code:
'This code will list all the procedures in all modules
Sub ListAllModuleProcedures()
  
On Error GoTo Err_Handler
        Dim VBAEditor As VBIDE.VBE
        Dim VBProj As VBIDE.VBProject
        Dim VBComp As VBIDE.VBComponent
        Dim CodeMod As VBIDE.CodeModule
        Dim LineNum As Long
        Dim NumLines As Long
        Dim ProcName As String
        Dim ProcKind As VBIDE.vbext_ProcKind
      
        Set VBAEditor = Application.VBE
        Set VBProj = VBAEditor.ActiveVBProject
      
        For Each VBComp In VBProj.VBComponents
            Set CodeMod = VBComp.CodeModule
            Debug.Print VBComp.Name
            With CodeMod
                LineNum = .CountOfDeclarationLines + 1
                Do Until LineNum >= .CountOfLines
                    ProcName = .ProcOfLine(LineNum, ProcKind)
                    LineNum = .ProcStartLine(ProcName, ProcKind) + _
                            .ProcCountLines(ProcName, ProcKind) + 1
                  Debug.Print "         - " & ProcName
                Loop
            End With
        Next VBComp
              
Exit_Handler:
        Exit Sub
      
Err_Handler:
    MsgBox "Error " & Err.number & " in ListAllStandardProcedures : " & Err.description
    GoTo Exit_Handler
  
End Sub

There is much more worth looking at as well on Chip's amazing website. A great pity he is no longer around ...
 

amorosik

Member
Local time
Today, 09:30
Joined
Apr 18, 2020
Messages
390
For Each VBComp In VBProj.VBComponents
Set CodeMod = VBComp.CodeModule
Debug.Print VBComp.Name
With CodeMod
LineNum = .CountOfDeclarationLines + 1
Do Until LineNum >= .CountOfLines
ProcName = .ProcOfLine(LineNum, ProcKind)
LineNum = .ProcStartLine(ProcName, ProcKind) + _
.ProcCountLines(ProcName, ProcKind) + 1
Debug.Print " - " & ProcName
Loop
End With
Next VBComp

The above pieces of code is not working properly
Using it on the code below, the LineNum variable from line 220 is no longer incremented and the loop continues indefinitely

Code:
Option Explicit
#Const HostProject = "Access" ', or Excel or Word

Public WithEvents TreeControl As MSForms.Frame

Private mbInActive                     
Private mbAlwaysRedesign As Boolean     
Private mbAutoSort As Boolean         
Private mbChanged As Boolean           
Private mbCheckboxes As Boolean       
Private mbLabelEdit As Boolean        
Private mbTriState As Boolean          
Private mbCheckboxImage As Boolean    
Private mbEditMode As Boolean        
Private mbFullWidth As Boolean       
Private mbGotIcons As Boolean        
Private mbExpanderImage As Boolean     
Private mbKeyDown As Boolean          
Private mbMove As Boolean              
Private mbRedesign As Boolean         
Private mbRootButton As Boolean        
Private mbShowExpanders As Boolean    
Private mbShowLines As Boolean       
Private mlBackColor As Long            
Private mlForeColor As Long           
Private mlLabelEdit As Long           
Private mlNodesCreated As Long      
Private mlNodesDeleted As Long      
Private mlVisCount As Long           
Private mlVisOrder() As Long         
Private msAppName As String             
Private msngChkBoxPad As Single       
Private msngChkBoxSize As Single        
Private msngIndent As Single           
Private msngLineLeft As Single         
Private msngNodeHeight As Single       
Private msngRootLine As Single       
Private msngTopChk As Single           
Private msngTopExpB As Single        
Private msngTopExpT As Single        
Private msngTopHV As Single          
Private msngTopIcon As Single        
Private msngTopLabel As Single       
Private msngVisTop As Single           
Private msngMaxWidths() As Single      
Private moActiveNode As clsTreeviewNode 
Private moEditNode As clsTreeviewNode  
Private moMoveNode As clsTreeviewNode   
Private moRootHolder As clsTreeviewNode
Private mcolIcons As Collection      
Private mcolNodes As Collection        
Private moCheckboxImage(-1 To 1) As StdPicture 
Private moExpanderImage(-1 To 0) As StdPicture 
#If HostProject = "Access" Then
  Private moForm As Access.Form       
#Else
  Private moForm As MSForms.UserForm
#End If
''-----------------------------------------------------------

Public Enum tvTreeRelationship
    tvFirst = 0
    tvLast = 1
    tvNext = 2
    tvPrevious = 3
    tvChild = 4
End Enum

Event Click(cNode As clsTreeviewNode)       'Node clcick event
Event NodeCheck(cNode As clsTreeviewNode)   'Checkbox change event
Event AfterLabelEdit(ByRef Cancel As Boolean, NewString As String, cNode As clsTreeviewNode)
Event KeyDown(cNode As clsTreeviewNode, ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
                    
Private Type POINTAPI
    x As Long
    Y As Long
End Type

#If VBA7 And Not Mac Then
    Private Declare PtrSafe Function GetCursorPos Lib "user32.dll" ( _
            ByRef lpPoint As POINTAPI) As Long
    Private Declare PtrSafe Function SetCursorPos Lib "user32.dll" ( _
            ByVal x As Long, _
            ByVal Y As Long) As Long
    Private Declare PtrSafe Function getTickCount Lib "kernel32.dll" Alias "GetTickCount" () As Long
#Else
    Private Declare Function GetCursorPos Lib "user32.dll" ( _
                                          ByRef lpPoint As POINTAPI) As Long
    Private Declare Function SetCursorPos Lib "user32.dll" ( _
                                          ByVal x As Long, _
                                          ByVal Y As Long) As Long
    Private Declare Function getTickCount Lib "kernel32.dll" Alias "GetTickCount" () As Long
#End If

' Mac displays at 72 pixels per 72 points vs (typically) 96/72 in Windows
' The respective constants help size and position node controls appropriatelly in the different OS
' Search the project for instances of the Mac constant

    Const mcCheckboxFont As Long = 10
    Const mcCheckboxPad As Single = 15
    Const mcCheckboxPadImg As Single = 11.25
    Const mcChkBoxSize As Single = 10.5
    Const mcExpanderFont As Long = 10
    Const mcExpButSize As Single = 11.25
    Const mcExpBoxSize As Long = 9
    Const mcFullWidth As Long = 600
    Const mcIconPad As Single = 14.25
    Const mcIconSize As Long = 12
    Const mcTLpad As Long = 3
    Const mcLineLeft As Single = mcTLpad + 7.5
    Const mcPtPxl As Single = 0.75

Private Const mcSource As String = "clsTreeView"

'***************************
'*    Public Properties    *
'***************************

Public Property Get ActiveNode() As clsTreeviewNode
    Set ActiveNode = moActiveNode
End Property

Public Property Set ActiveNode(oActiveNode As clsTreeviewNode)

    Dim cTmp As clsTreeviewNode
    If oActiveNode Is MoveCopyNode(False) Then
        Set MoveCopyNode(False) = Nothing
    End If

    If moActiveNode Is oActiveNode Then
        SetActiveNodeColor
        Exit Property
    End If
    
    ResetActiveNodeColor ActiveNode

    If oActiveNode.Control Is Nothing Then
        Set cTmp = oActiveNode.ParentNode
        While Not cTmp.caption = "RootHolder"
            cTmp.Expanded = True
            Set cTmp = cTmp.ParentNode
        Wend

        If mlNodesCreated Then
            BuildRoot False
        End If

    End If

    Set moActiveNode = oActiveNode
    SetActiveNodeColor

End Property

Public Sub ExpandNode(cNode As clsTreeviewNode)
    Dim cTmp As clsTreeviewNode

    Set cTmp = cNode.ParentNode
    While Not cTmp.caption = "RootHolder"
        cTmp.Expanded = True
    Wend
    
End Sub

Public Property Get AppName() As String
    AppName = msAppName
End Property

Public Property Let AppName(ByVal sAppName As String)
    msAppName = sAppName
End Property

Public Property Get Changed() As Boolean
'PT user has edited node(s) and/or changed Checked value(s)
    Changed = mbChanged
End Property

Public Property Let Changed(ByVal bChanged As Boolean)
' called after manual node edit and Checked change
    mbChanged = bChanged
End Property

Public Property Get CheckBoxes(Optional bTriState As Boolean) As Boolean    ' PT
    CheckBoxes = mbCheckboxes
    bTriState = mbTriState
End Property

Public Property Let CheckBoxes(Optional bTriState As Boolean, ByVal bCheckboxes As Boolean)   ' PT
    Dim bOrig As Boolean
    Dim bOrigTriState As Boolean

    bOrig = mbCheckboxes
    mbCheckboxes = bCheckboxes

    bOrigTriState = mbTriState
    mbTriState = bTriState
    If bCheckboxes Then
        msngChkBoxPad = mcCheckboxPad
        If msngNodeHeight < mcExpButSize Then msngNodeHeight = mcExpButSize
    Else
        msngChkBoxPad = 0
    End If

    If Not TreeControl Is Nothing Then

        If TreeControl.Controls.count And (bOrig <> mbCheckboxes Or bOrigTriState <> mbTriState) Then
            ' Checkboxes added changed after start-up so update the treeview
            mbRedesign = True
            Refresh
        End If
    End If

End Property

#If HostProject = "Access" Then
    Public Property Set Form(frm As Access.Form)
        Set moForm = frm
    End Property
#Else
    Public Property Set Form(frm As MSForms.UserForm)
        Set moForm = frm
    End Property
#End If

Public Property Get FullWidth() As Boolean
    FullWidth = mbFullWidth
End Property

Public Property Let FullWidth(bFullWidth As Boolean)
    mbFullWidth = bFullWidth
End Property
 
Last edited:

isladogs

MVP / VIP
Local time
Today, 08:30
Joined
Jan 14, 2017
Messages
18,216
Which is line 220 in your code?
BTW the immediate window can only hold a certain number of lines of information.
If you have a lot of items, it is safer to do this one module at a time
 

amorosik

Member
Local time
Today, 09:30
Joined
Apr 18, 2020
Messages
390
Which is line 220 in your code?
BTW the immediate window can only hold a certain number of lines of information.
If you have a lot of items, it is safer to do this one module at a time

#If HostProject = "Access" Then
Public Property Set Form(frm As Access.Form)
Set moForm = frm
End Property
#Else
Public Property Set Form(frm As MSForms.UserForm) ' This is line 220
Set moForm = frm
End Property
#End If
 

Gasman

Enthusiastic Amateur
Local time
Today, 08:30
Joined
Sep 21, 2011
Messages
14,267
Does the same for me, but each property comes up in it's own section?
1656412535961.png
 

isladogs

MVP / VIP
Local time
Today, 08:30
Joined
Jan 14, 2017
Messages
18,216
In class modules like this you will often see lines like Get Form / Set Form or in your case Set Form twice due to the conditional compilation.
As written, the code will list each of these as just Form.

You may wish to amend the code so it gives the full procedure name / property name
Offhand, I've no idea why its doing an infinite loop.
 

amorosik

Member
Local time
Today, 09:30
Joined
Apr 18, 2020
Messages
390
In class modules like this you will often see lines like Get Form / Set Form or in your case Set Form twice due to the conditional compilation.
As written, the code will list each of these as just Form.

You may wish to amend the code so it gives the full procedure name / property name
Offhand, I've no idea why its doing an infinite loop.

Because .ProcStartLine(ProcName, ProcKind) always returns the first occurrence of "Public Property Set Form ("
 

Users who are viewing this thread

Top Bottom