From dfaf5d9f62de2fbf4b4e047d86870d5692af7d2d Mon Sep 17 00:00:00 2001
From: joyfullservice <joyfullservice@users.noreply.github.com>
Date: Mon, 27 Nov 2023 08:32:39 -0600
Subject: [PATCH] Support for PublicCreatable instancing for classes

This (technically undocumented) technique allows class objects to be created by external projects without using factory methods. This approach was used in some of my projects, so it was important for me to see this property correctly set when the application was built from source.
---
 .../modules/clsDbModule.cls                   | 19 ++++++++++++++++---
 1 file changed, 16 insertions(+), 3 deletions(-)

diff --git a/Version Control.accda.src/modules/clsDbModule.cls b/Version Control.accda.src/modules/clsDbModule.cls
index d1b98c36..b23227e3 100644
--- a/Version Control.accda.src/modules/clsDbModule.cls	
+++ b/Version Control.accda.src/modules/clsDbModule.cls	
@@ -24,6 +24,7 @@ Private m_FileList As Dictionary
 Private Type udtVbaFileContent
     strContent As String
     blnIsClass As Boolean
+    blnPublicCreatable As Boolean
 End Type
 
 ' This requires us to use all the public methods and properties of the implemented class
@@ -70,6 +71,8 @@ End Sub
 '
 Private Sub IDbComponent_Import(strFile As String)
 
+    Const cintPublicCreateable As Integer = 5   ' Instancing
+
     Dim strName As String
     Dim strTempFile As String
     Dim udtFile As udtVbaFileContent
@@ -94,6 +97,12 @@ Private Sub IDbComponent_Import(strFile As String)
     Set VBE.ActiveVBProject = CurrentVBProject
     DoCmd.Save acModule, strName
 
+    ' Update instancing for public creatable classes
+    If udtFile.blnPublicCreatable Then
+        CurrentVBProject.VBComponents(strName).Properties("Instancing") = cintPublicCreateable
+        DoCmd.Save acModule, strName
+    End If
+
     ' Set reference to object
     LogUnhandledErrors
     On Error Resume Next
@@ -124,6 +133,8 @@ Private Function ParseSourceFile(strFile As String, strName As String) As udtVba
     Dim cData As clsConcat
     Dim blnIsClass As Boolean
     Dim blnHasHeader As Boolean
+    Dim blnCreatable As Boolean
+    Dim blnPublic As Boolean
 
     Perf.OperationStart "Parse VBA Module"
 
@@ -136,15 +147,16 @@ Private Function ParseSourceFile(strFile As String, strName As String) As udtVba
             ' Class with VBE header
             blnIsClass = True
             blnHasHeader = True
-            Exit For
         ElseIf StartsWith(strLines(lngLine), "Attribute VB_Name = """) Then
             ' Module with VBE header
             blnHasHeader = True
-            Exit For
         ElseIf StartsWith(strLines(lngLine), "Attribute VB_GlobalNameSpace = ") Then
             ' Class with no header
             blnIsClass = True
-            Exit For
+        ElseIf strLines(lngLine) = "Attribute VB_Creatable = True" Then
+            blnCreatable = True
+        ElseIf strLines(lngLine) = "Attribute VB_Exposed = True" Then
+            blnPublic = True
         End If
         ' Exit after 9 lines
         If lngLine > 8 Then Exit For
@@ -179,6 +191,7 @@ Private Function ParseSourceFile(strFile As String, strName As String) As udtVba
     With ParseSourceFile
         .blnIsClass = blnIsClass
         .strContent = cData.GetStr
+        .blnPublicCreatable = (blnCreatable And blnPublic)
     End With
 
     Perf.OperationEnd