Objective:
Have a single point of entrance to initialize a class that holds instances of "sub" classes
Background:
- I read about inheritance in VBA (or as close as you will) in this post and it occurred to me that you could have a hierarchy of classes/objects so accessing them while coding would be easier
- Thought about how to initialize the "base" class in order to recover from code crashes in this post
- Read about Lazy object / weak reference in this post and got worried about this could be happening in my project
Questions:
- Is this a source of a memory leak risk? (see my post about the idea of a framework here where I'm asking from a different perspective because in this case I am creating a new instance of the base class inside the function)
- The idea of a single point of entrance to initialize the class is "compatible" / recommeded with the whole classes hierarchy approach?
Code / File structure:
Code components:
Module: AppMacros
Description: This is the function that I call to access the classes in the whole application.
'@Version(1)
'@Folder("App")
Option Explicit
Private Const ModuleName As String = "AppMacros"
Public Function AppWorkbook() As App
On Error GoTo CleanFail
Static newApp As App
If newApp Is Nothing Then
Set newApp = App.Create
LogManager.Register TableLogger.Create("AppInfoLogger", PerfLevel, "TablaRegistroApp")
newApp.SecurityManager.RestoreSheetsProtection
newApp.SecurityManager.RestoreWorkbookProtection
End If
Set AppWorkbook = newApp
CleanExit:
Exit Function
CleanFail:
ErrorHandler.DisplayMessage ModuleName, "InitAppWorkbook", Err.Number, Err.Description, , True
If Not DebugMode Then Resume CleanExit Else: Stop: Resume
End Function
I call it like this:
And call a function from one of the sub classes:
Class: App
'@Version(1)
'@Folder("App")
Option Explicit
'@PredeclaredId
' Copywrite (C) 2019 Ricardo Diaz
' This file is distributed under the GPL-3.0 license
' Obtain a copy of the GPL-3.0 license <http://opensource.org/licenses/GPL-3.0>
Private Type TApp
DateUpdated As Date
AutomationManager As AutomationManager
ConfigManager As ConfigManager
DisplayManager As DisplayManager
ExternalDataManager As ExternalDataManager
ErrorHandler As ErrorHandler
NavigationManager As NavigationManager
OptionsManager As OptionsManager
ParamManager As ParamManager
PerfManager As PerfManager
RoadMapManager As RoadMapManager
SecurityManager As SecurityManager
SettingsManager As DefaultsManager
StartManager As StartManager
StateManager As StateManager
TaskManager As TaskManager
VersionManager As VersionManager
End Type
Private this As TApp
Public Property Get DateUpdated() As Date
DateUpdated = this.DateUpdated
End Property
Public Property Let DateUpdated(ByVal vNewValue As Date)
this.DateUpdated = vNewValue
End Property
Public Property Get Self() As App
Set Self = Me
End Property
Public Property Get AutomationManager() As AutomationManager
Set AutomationManager = this.AutomationManager
End Property
Friend Property Set AutomationManager(ByVal Value As AutomationManager)
Set this.AutomationManager = Value
End Property
Public Property Get ConfigManager() As ConfigManager
Set ConfigManager = this.ConfigManager
End Property
Friend Property Set ConfigManager(ByVal Value As ConfigManager)
Set this.ConfigManager = Value
End Property
Public Property Get DisplayManager() As DisplayManager
Set DisplayManager = this.DisplayManager
End Property
Friend Property Set DisplayManager(ByVal Value As DisplayManager)
Set this.DisplayManager = Value
End Property
Public Property Get ErrorHandler() As ErrorHandler
Set ErrorHandler = this.ErrorHandler
End Property
Friend Property Set ErrorHandler(ByVal Value As ErrorHandler)
Set this.ErrorHandler = Value
End Property
Public Property Get ExternalDataManager() As ExternalDataManager
Set ExternalDataManager = this.ExternalDataManager
End Property
Friend Property Set ExternalDataManager(ByVal Value As ExternalDataManager)
Set this.ExternalDataManager = Value
End Property
Public Property Get NavigationManager() As NavigationManager
Set NavigationManager = this.NavigationManager
End Property
Friend Property Set NavigationManager(ByVal Value As NavigationManager)
Set this.NavigationManager = Value
End Property
Public Property Get OptionsManager() As OptionsManager
Set OptionsManager = this.OptionsManager
End Property
Friend Property Set OptionsManager(ByVal Value As OptionsManager)
Set this.OptionsManager = Value
End Property
Public Property Get ParamManager() As ParamManager
Set ParamManager = this.ParamManager
End Property
Friend Property Set ParamManager(ByVal Value As ParamManager)
Set this.ParamManager = Value
End Property
Public Property Get PerfManager() As PerfManager
Set PerfManager = this.PerfManager
End Property
Friend Property Set PerfManager(ByVal Value As PerfManager)
Set this.PerfManager = Value
End Property
Public Property Get RoadMapManager() As RoadMapManager
Set RoadMapManager = this.RoadMapManager
End Property
Friend Property Set RoadMapManager(ByVal Value As RoadMapManager)
Set this.RoadMapManager = Value
End Property
Public Property Get SecurityManager() As SecurityManager
Set SecurityManager = this.SecurityManager
End Property
Friend Property Set SecurityManager(ByVal Value As SecurityManager)
Set this.SecurityManager = Value
End Property
Public Property Get SettingsManager() As DefaultsManager
Set SettingsManager = this.SettingsManager
End Property
Friend Property Set SettingsManager(ByVal Value As DefaultsManager)
Set this.SettingsManager = Value
End Property
Public Property Get StartManager() As StartManager
Set StartManager = this.StartManager
End Property
Friend Property Set StartManager(ByVal Value As StartManager)
Set this.StartManager = Value
End Property
Public Property Get StateManager() As StateManager
Set StateManager = this.StateManager
End Property
Friend Property Set StateManager(ByVal Value As StateManager)
Set this.StateManager = Value
End Property
Public Property Get TaskManager() As TaskManager
Set TaskManager = this.TaskManager
End Property
Friend Property Set TaskManager(ByVal Value As TaskManager)
Set this.TaskManager = Value
End Property
Public Property Get VersionManager() As VersionManager
Set VersionManager = this.VersionManager
End Property
Friend Property Set VersionManager(ByVal Value As VersionManager)
Set this.VersionManager = Value
End Property
'@Ignore FunctionReturnValueNotUsed
Public Function Create() As App
With New App
Set .AutomationManager = New AutomationManager
Set .ConfigManager = New ConfigManager
Set .DisplayManager = New DisplayManager
Set .ErrorHandler = New ErrorHandler
Set .ExternalDataManager = New ExternalDataManager
Set .NavigationManager = New NavigationManager
Set .OptionsManager = New OptionsManager
Set .ParamManager = New ParamManager
Set .PerfManager = New PerfManager
Set .RoadMapManager = New RoadMapManager
Set .SecurityManager = New SecurityManager
Set .SettingsManager = New DefaultsManager
Set .StartManager = New StartManager
Set .StateManager = New StateManager
Set .TaskManager = New TaskManager
Set .VersionManager = New VersionManager
.VersionManager.Create
Set Create = .Self
End With
End Function
Class (sub-class): ExternalDataManager
'@Version(2 )
'@Folder("App.ExternalData")
Option Explicit
'@PredeclaredId
' Copywrite (C) 2019 Ricardo Diaz
' This file is distributed under the GPL-3.0 license
' Obtain a copy of the GPL-3.0 license <http://opensource.org/licenses/GPL-3.0>
'
' Private Members
' ---------------
'
'
' Public Members
' --------------
'
'
' Private Methods
' ---------------
'
Private Function DoesQueryExist(ByVal QueryName As String) As Boolean
' Helper function to check if a query with the given name already exists
Dim evalQuery As WorkbookQuery
If (ThisWorkbook.Queries.Count = 0) Then
DoesQueryExist = False
Exit Function
End If
For Each evalQuery In ThisWorkbook.Queries
If (evalQuery.Name = QueryName) Then
DoesQueryExist = True
Exit Function
End If
Next
DoesQueryExist = False
End Function
Private Sub RefreshQueryWaitUntilFinish(ByVal currentConnection As WorkbookConnection)
Dim backgroundRefresh As Boolean
With currentConnection.OLEDBConnection
backgroundRefresh = .BackgroundQuery
.BackgroundQuery = False
.Refresh
.BackgroundQuery = backgroundRefresh
End With
End Sub
Private Sub LoadToWorksheetOnly(ByVal query As WorkbookQuery, ByVal loadSheet As Worksheet)
' The usual VBA code to create ListObject with a Query Table
' The interface is not new, but looks how simple is the connection string of Power Query:
' "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=" & query.Name
With loadSheet.ListObjects.Add(SourceType:=0, source:= _
"OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=" & query.Name _
, destination:=Range("$A$1")).queryTable
.CommandType = xlCmdDefault
.CommandText = Array("SELECT * FROM [" & query.Name & "]")
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = False
.Refresh BackgroundQuery:=False
End With
End Sub
Private Sub LoadToWorksheetAndModel(ByVal query As WorkbookQuery, ByVal currentSheet As Worksheet)
' Let's load the query to the Data Model
LoadToDataModel query
' Now we can load the data to the worksheet
With currentSheet.ListObjects.Add(SourceType:=4, source:=ActiveWorkbook. _
Connections("Query - " & query.Name), destination:=Range("$A$1")).TableObject
.RowNumbers = False
.PreserveFormatting = True
.PreserveColumnInfo = False
.AdjustColumnWidth = True
.RefreshStyle = 1
.ListObject.DisplayName = Replace(query.Name, " ", "_") & "_ListObject"
.Refresh
End With
End Sub
Private Sub LoadToDataModel(ByVal query As WorkbookQuery)
' This code loads the query to the Data Model
ThisWorkbook.Connections.Add2 "Query - " & query.Name, _
"Connection to the '" & query.Name & "' query in the workbook.", _
"OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=" & query.Name _
, """" & query.Name & """", 6, True, False
End Sub
'@Ignore ProcedureNotUsed
Private Sub ReplaceStringInWorkBook(ByVal SearchFor As String, ByVal ReplaceWith As String)
Dim evalQuery As WorkbookQuery
For Each evalQuery In ThisWorkbook.Queries
ReplaceStringInQuery evalQuery.Name, SearchFor, ReplaceWith
Next evalQuery
End Sub
Private Sub ReplaceStringInQuery(ByVal QueryName As String, ByVal SearchFor As String, ByVal ReplaceWith As String)
Dim queryFormula As String
Dim queryResult As String
If DoesQueryExist(QueryName) = False Then Exit Sub
queryFormula = ThisWorkbook.Queries(QueryName).Formula
queryResult = Replace(queryFormula, SearchFor, ReplaceWith)
ThisWorkbook.Queries(QueryName).Formula = queryResult
End Sub
'@Ignore ProcedureNotUsed, AssignedByValParameter
Public Sub TransferQueries(Optional ByVal FromWorkbook As Workbook, Optional ByVal ToWorkbook As Workbook, Optional ByVal overwrite As Boolean = False)
Dim sourceQuery As WorkbookQuery
If FromWorkbook Is Nothing Then Set FromWorkbook = Application.ThisWorkbook
If ToWorkbook Is Nothing Then Set ToWorkbook = Application.ActiveWorkbook
If FromWorkbook.fullName = ToWorkbook.fullName Then Exit Sub
For Each sourceQuery In FromWorkbook.Queries
If QueryExists(sourceQuery.Name, ToWorkbook) Then
If overwrite Then
ToWorkbook.Queries(sourceQuery.Name).Delete
ToWorkbook.Queries.Add sourceQuery.Name, sourceQuery.Formula, sourceQuery.Description
End If
Else
ToWorkbook.Queries.Add sourceQuery.Name, sourceQuery.Formula, sourceQuery.Description
End If
Next
End Sub
' check if a given query exists in the given workbook
'@Ignore ProcedureNotUsed, AssignedByValParameter
Private Function QueryExists(ByVal EvalQueryName As String, Optional ByVal evalWorkbook As Workbook) As Boolean
If evalWorkbook Is Nothing Then Set evalWorkbook = Application.ActiveWorkbook
On Error Resume Next
QueryExists = CBool(Len(evalWorkbook.Queries(EvalQueryName).Name))
On Error GoTo 0
End Function
'
'
' Constructors
' ------------
'
'
' Class
' -----
'
' Private Sub Class_Initialize() : End Sub
'
' Enumerator
' Public Property Get NewEnum() As IUnknown : Attribute NewEnum.VB_UserMemId = -4 : Set NewEnum = pCollec.[_NewEnum] : End Property
'
' Public Methods
' --------------
'
Public Sub DisplayQueriesPane(ByVal Show As Boolean)
Application.CommandBars("Queries and Connections").visible = Show
Application.CommandBars("Queries and Connections").Width = 300
End Sub
'@Ignore ProcedureNotUsed
Public Sub ToggleQueriesPane()
Application.CommandBars("Queries and Connections").visible = _
Not (Application.CommandBars("Queries and Connections").visible)
Application.CommandBars("Queries and Connections").Width = 300
End Sub
Public Sub UpdateAll()
AppWorkbook.StateManager.DisplayStatusBarMessage True, , "(Actualizando todas las conexiones de datos)"
ThisWorkbook.RefreshAll
AppWorkbook.StateManager.DisplayStatusBarMessage True, , "(Actualización de todas las conexiones de datos finalizada)"
End Sub
Public Sub UpdateDataModel()
AppWorkbook.StateManager.DisplayStatusBarMessage True, , "(Inicializando modelo de datos)"
ThisWorkbook.Model.Initialize
AppWorkbook.StateManager.DisplayStatusBarMessage True, , "(Modelo de datos inicializado, actualizando)"
ThisWorkbook.Model.Refresh
AppWorkbook.StateManager.DisplayStatusBarMessage True, , "(Actualización del modelo de datos finalizada)"
End Sub
Public Sub Update(Optional ByVal QueryName As String)
Dim currentConnection As WorkbookConnection
For Each currentConnection In ThisWorkbook.Connections
Select Case QueryName <> vbNullString
Case True
If InStr(currentConnection.Name, QueryName) > 0 Then RefreshQueryWaitUntilFinish currentConnection
Case False
RefreshQueryWaitUntilFinish currentConnection
End Select
Next currentConnection
End Sub
'Refresh particular PowerPivot table
'@Ignore ProcedureNotUsed
Public Sub UpdatedPowerPivotTable(ByVal QueryName As String)
ThisWorkbook.Model.Initialize
ThisWorkbook.Connections(QueryName).Refresh
End Sub
' Credits from here under: https://gallery.technet.microsoft.com/office/VBA-to-automate-Power-956a52d1
' Adapted by Ricardo Diaz
Public Sub DeleteQuery(ByVal QueryName As String)
Dim evalQuery As WorkbookQuery
' We get from the first worksheets all the data in order to know which query to delete, including its worksheet, connection and Data Model is needed
Dim evalConnection As WorkbookConnection
Dim connectionString As String
For Each evalConnection In ThisWorkbook.Connections
If Not evalConnection.InModel Then
' This is not a Data Model conenction. We created this connection without the "Power Query - " prefix, to determine if we should delete it, let's check the connection string
If Not IsNull(evalConnection.OLEDBConnection) Then
' This is a OLEDB Connection. Good chance it is our connection. Let's check the connection string
connectionString = evalConnection.OLEDBConnection.Connection
Dim prefix As String
prefix = "Provider=Microsoft.Mashup.OleDb.1;"
If (Left$(connectionString, Len(prefix)) = prefix) And (0 < InStr(connectionString, "Location=" & QueryName)) Then
' This is our connection
' It starts with "Provider=Microsoft.Mashup.OleDb.1;" and contains "Location=" with our query name. This is our connection.
evalConnection.Delete
End If
End If
ElseIf (InStr(1, evalConnection.Name, "Query - " & QueryName)) Then
' We created this connection with "Power Query - " prefix, so we can this connection
evalConnection.Delete
End If
Next
If DoesQueryExist(QueryName) Then
' Deleting the query
Set evalQuery = ThisWorkbook.Queries(QueryName)
evalQuery.Delete
End If
End Sub
' In parameters if not used "" rather vbNullString adding the query raises an error
'@Ignore ProcedureNotUsed, EmptyStringLiteral
Public Sub CreateQuery(ByVal QueryName As String, ByVal codeM As String, Optional ByVal shouldLoadToDataModel As Boolean = False, Optional ByVal shouldLoadToWorksheet As Boolean = False, Optional ByVal queryDescription As String = "")
Dim evalQuery As WorkbookQuery
Dim currentSheet As Worksheet
If DoesQueryExist(QueryName) Then
DeleteQuery QueryName
End If
' The new interface to create a new Power Query query. It gets as an input the query name, codeM formula and description (if description is empty, th
Set evalQuery = ThisWorkbook.Queries.Add(QueryName, codeM, queryDescription)
If shouldLoadToWorksheet Then
' We add a new worksheet with the same name as the Power Query query
Set currentSheet = ThisWorkbook.Sheets.Add(After:=ActiveSheet)
currentSheet.Name = QueryName
If Not shouldLoadToDataModel Then
' Let's load to worksheet only
LoadToWorksheetOnly evalQuery, currentSheet
Else
' Let's load to worksheet and Data Model
LoadToWorksheetAndModel evalQuery, currentSheet
End If
ElseIf shouldLoadToDataModel Then
' No need to load to worksheet, only Data Model
LoadToDataModel evalQuery
End If
End Sub
Public Sub CreateNameParameterQueriesFromRange(ByVal EvalRange As Range)
Dim EvalCell As Range
For Each EvalCell In EvalRange.Cells
CreateNameParameterQueryFromCell EvalCell
Next EvalCell
End Sub
Public Sub CreateNameParameterQueryFromCell(ByVal CurrentCell As Range)
If Framework.Name.DoesNameExists(CurrentCell) = False Then Exit Sub
Dim QueryName As String
Dim baseCode As String
Dim wrapCode As String
Dim cellStyleType As Long
QueryName = CurrentCell.Name.Name
baseCode = "fnCargarParamExcel(""<cellName>"", <cellStyleType>) meta [IsParameterQuery=true, Type=""Number"", IsParameterQueryRequired=false]"
' Cells style types defined in Styles classes TODO: decouple class from constants
' 1 Text
' 2 Number
' 3 Date
Select Case True
Case InStr(LCase$(CurrentCell.style.Name), constStyleNameContainsDate)
cellStyleType = 3
Case InStr(LCase$(CurrentCell.style.Name), constStyleNameContainsYear), InStr(LCase$(CurrentCell.style.Name), constStyleNameContainsNumber), InStr(LCase$(CurrentCell.style.Name), constStyleNameContainsCurrency), InStr(LCase$(CurrentCell.style.Name), constStyleNameContainsMultiple), InStr(LCase$(CurrentCell.style.Name), constStyleNameContainsPercentage)
cellStyleType = 2
Case Else
cellStyleType = 1
End Select
'@Ignore AssignmentNotUsed
wrapCode = Replace(baseCode, "<cellName>", QueryName)
wrapCode = Replace(wrapCode, "<cellStyleType>", cellStyleType)
CreateQuery QueryName, wrapCode, False, False
End Sub
Code has annotations from Rubberduck add-in
With
blocks) is non-zero, the object will hang around. The memory leak you're worried about here would be a circular reference, where a parent class holds a reference to a child class and the child holds a reference to the parent ... \$\endgroup\$ExternalDataManager
has a reference toApp
. In that case, if you create aNew App
(+1 reference) then later it falls out of scope (-1 reference), theApp
object will not be destroyed since its child subclass still holds a reference to it, and the child won't be destroyed since the parent still holds a reference to it. You never passMe
to the subclasses so there should be no circular references. As for weak references, these are where you save a pointer and dereference it - not native VBA so you'd know if you were doing it! Q. 2) is more nuanced so I'll leave for reviewers \$\endgroup\$Workbook_BeforeClose
event. As for debugging, I'd recommend sprinklingDebug.Print
in theClass_Terminate
handlers to check things are being closed as expected. \$\endgroup\$