Skip to content

Commit

Permalink
Support for PublicCreatable instancing for classes
Browse files Browse the repository at this point in the history
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.
  • Loading branch information
joyfullservice committed Nov 27, 2023
1 parent 3f1c31d commit dfaf5d9
Showing 1 changed file with 16 additions and 3 deletions.
19 changes: 16 additions & 3 deletions Version Control.accda.src/modules/clsDbModule.cls
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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"

Expand All @@ -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
Expand Down Expand Up @@ -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
Expand Down

0 comments on commit dfaf5d9

Please sign in to comment.