Code Library

SetPredeclaredId(): Change the Hidden PredeclaredId Attribute of a VBA Class Module

This simple function overcomes the lack of a hidden attribute editor for PredeclaredId values in the VBA development environment.

Mike Wolfe

Oct 5, 2022 • 7 min read

In the past, I wrote that I knew of only two ways to set the PredeclaredId attribute of a class module:

The Manual Method: Export - Import Cycle
The Automatic Method: Rubberduck VBA

Today, I'm going to share with you a third way: the SetPredeclaredId routine.

The Algorithm

The algorithm is really quite simple.

Rather than diving straight into the code, I used the Pseudocode Programming concept from Steve McConnell's legendary book, Code Complete. Here is the algorithm I started with:

Export the class module to a temporary file
Load the contents of the file into a string variable
Set the PredeclaredId attribute
Write the contents of the string to the temp file
LoadFromText the contents of the temp file
Delete the temp file

As you can see, it's nothing more than an automated version of the Export-Import Cycle method listed above.

The SetPredeclaredId Routine

Once I had the algorithm, all I had to do was fill in the code:

' ----------------------------------------------------------------
' Procedure : SetPredeclaredId
' Date      : 10/5/2022
' Author    : Mike Wolfe
' Source    : https://nolongerset.com/setpredeclaredid/
' Purpose   : Set the hidden PredeclaredId attribute of a VBA class module.
' ----------------------------------------------------------------
Public Sub SetPredeclaredId(ClassName As String, PredeclaredId As Boolean)
    'Export the class module to a temporary file
    Dim fpTemp As String: fpTemp = GetGuidBasedTempPath
    SaveAsText acModule, ClassName, fpTemp
    
    'Load the contents of the file into a string variable
    Dim s As String
    s = FileRead(fpTemp)
    
    'Set the PredeclaredID attribute
    If PredeclaredId Then
        s = Replace(s, Count:=1, _
                    Find:="Attribute VB_PredeclaredId = False", _
                    Replace:="Attribute VB_PredeclaredId = True")
    Else
        s = Replace(s, Count:=1, _
                    Find:="Attribute VB_PredeclaredId = True", _
                    Replace:="Attribute VB_PredeclaredId = False")
    End If
    
    'Write the contents of the string to the temp file
    FileWrite fpTemp, s
    
    'LoadFromText the contents of the temp file
    LoadFromText acModule, ClassName, fpTemp
    
    'Delete the temp file
    Kill fpTemp
End Sub

Dependencies

The code looks so simple because I built it atop several existing functions in my code library, available from the following articles:

Don't worry. You don't need to read all those. The code below has everything you need.

The Full Code

Simply copy and paste the code below into an empty standard code module:

Option Compare Database
Option Explicit

'--== Declare lines for CreateGUID() ==--
#If VBA7 Then
    Private Declare PtrSafe Function CoCreateGuid Lib "ole32" (id As Any) As Long
#Else
    Private Declare Function CoCreateGuid Lib "ole32" (id As Any) As Long
#End If

'--== Declare lines for DeleteFile() ==--
#If VBA7 Then
    Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#Else
    Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If



' ----------------------------------------------------------------
' Procedure : SetPredeclaredId
' Date      : 10/5/2022
' Author    : Mike Wolfe
' Source    : https://nolongerset.com/setpredeclaredid/
' Purpose   : Set the hidden PredeclaredId attribute of a VBA class module.
' ----------------------------------------------------------------
Public Sub SetPredeclaredId(ClassName As String, PredeclaredId As Boolean)
    'Export the class module to a temporary file
    Dim fpTemp As String: fpTemp = GetGuidBasedTempPath
    SaveAsText acModule, ClassName, fpTemp
    
    'Load the contents of the file into a string variable
    Dim s As String
    s = FileRead(fpTemp)
    
    'Set the PredeclaredID attribute
    If PredeclaredId Then
        s = Replace(s, Count:=1, _
                    Find:="Attribute VB_PredeclaredId = False", _
                    Replace:="Attribute VB_PredeclaredId = True")
    Else
        s = Replace(s, Count:=1, _
                    Find:="Attribute VB_PredeclaredId = True", _
                    Replace:="Attribute VB_PredeclaredId = False")
    End If
    
    'Write the contents of the string to the temp file
    FileWrite fpTemp, s
    
    'LoadFromText the contents of the temp file
    LoadFromText acModule, ClassName, fpTemp
    
    'Delete the temp file
    Kill fpTemp
End Sub


' ----------------------------------------------------------------
' Procedure : GetGuidBasedTempPath
' Date      : 9/30/2022
' Author    : Mike Wolfe
' Source    : https://nolongerset.com/getguidbasedtemppath/
' Purpose   : Returns an unused full path in the user's temp folder.
' Requires  : CreateGUID() from https://nolongerset.com/createguid/
' Notes     - For efficiency, the file name is based on a GUID which
'               obviates the need to check for an existing file.
' Usage     : ?GetGuidBasedTempPath()  'produces something like:
'   C:\Users\Mike\AppData\Local\Temp\11132708-F988-E84A-ADB0-F27F133B2116.tmp
' ----------------------------------------------------------------
Private Function GetGuidBasedTempPath(Optional FileExt As String = "tmp")
    'Build the destination folder with trailing slash
    Dim foDest As String
    foDest = Environ("TMP")
    If Right(foDest, 1) <> "\" Then foDest = foDest & "\"
    
    'Build the destination filename with extension
    Dim fnDest As String
    fnDest = CreateGUID() & "." & FileExt
    
    'Combine the folder and filename to create the full path
    GetGuidBasedTempPath = foDest & fnDest
End Function


' ----------------------------------------------------------------
' Procedure  : CreateGUID
' Author     : Dan (webmaster@1stchoiceav.com)
' Source     : http://allapi.mentalis.org/apilist/CDB74B0DFA5C75B7C6AFE60D3295A96F.html
' Adapted by : Mike Wolfe
' Republished: https://nolongerset.com/createguid/
' Date       : 8/5/2022
' ----------------------------------------------------------------
Private Function CreateGUID() As String
    Const S_OK As Long = 0
    Dim id(0 To 15) As Byte
    Dim Cnt As Long, GUID As String
    If CoCreateGuid(id(0)) = S_OK Then
        For Cnt = 0 To 15
            CreateGUID = CreateGUID & IIf(id(Cnt) < 16, "0", "") + Hex$(id(Cnt))
        Next Cnt
        CreateGUID = Left$(CreateGUID, 8) & "-" & _
                     Mid$(CreateGUID, 9, 4) & "-" & _
                     Mid$(CreateGUID, 13, 4) & "-" & _
                     Mid$(CreateGUID, 17, 4) & "-" & _
                     Right$(CreateGUID, 12)
    Else
        MsgBox "Error while creating GUID!"
    End If
End Function

'Returns the contents of file FName as a string
Private Function FileRead(FName As String) As String
Dim FNum As Integer, Result As String
    
    Result = Space(FileLen(FName))
    FNum = FreeFile
    Open FName For Binary Access Read As #FNum
    Get #FNum, , Result
    Close FNum
    FileRead = Result

End Function

'Writes a text file with the contents of a string
'   - Creates the file if it does not exist
'   - Overwrites the contents of an existing file without warning
'   - Returns true if successful
Private Function FileWrite(FName As String, Contents As String) As Boolean
    If Not DeleteFile(FName) Then Exit Function
    Dim FNum As Integer
    FNum = FreeFile()
    Open FName For Output As FNum
    'trailing semi-colon needed to prevent adding blank line at end of file
    '  see: http://stackoverflow.com/a/9445141/154439
    Print #FNum, Contents;
    Close #FNum
    FileWrite = True
End Function

'Appends the contents to the end of a file
' - if the file does not exist, it is created
' - a new line is implicitly added after the contents
'   `- this means that FileAppend may be repeatedly called without passing any vbCrLf's
Private Sub FileAppend(FName As String, Contents As String)
    If Not FileExists(FName) Then
        'File does not exist, create new via FileWrite
        FileWrite FName, Contents & vbCrLf
    Else
        Dim FNum As Integer
        FNum = FreeFile()
        Open FName For Append Access Write As #FNum
        Print #FNum, Contents
        Close #FNum
    End If
End Sub


'https://nolongerset.com/the-subtle-dangers-of-dir/
Private Function FileExists(FullPathOfFile As String)
    Dim HasWildcards As Boolean
    HasWildcards = (InStr(FullPathOfFile, "*") > 0) Or (InStr(FullPathOfFile, "?") > 0)
    
    If HasWildcards Then
        FileExists = (Len(Dir(FullPathOfFile)) > 0)
    Else
        Dim oFSO As Object 'Scripting.FileSystemObject
        Set oFSO = CreateObject("Scripting.FileSystemObject")
        FileExists = oFSO.FileExists(FullPathOfFile)
    End If
End Function

'https://nolongerset.com/kill-failed-let-user-try-again/
Private Function DeleteFile(FName As String, _
                    Optional DelayInSeconds As Long = 0, _
                    Optional Silent As Boolean = False) As Boolean
    Dim StartTime As Date, Complete As Boolean
    On Error Resume Next
    StartTime = Now()
    Do Until Complete
        Err.Clear
        Kill FName
        If Not FileExists(FName) Then
            DeleteFile = True
            Complete = True
            Exit Function
        End If
        If Err.Number <> 0 Then
            If (Now() - StartTime) * 86400 > DelayInSeconds Then
                If Not Silent Then
                    If MsgBox("Unable to delete file:" & vbCrLf & vbCrLf & _
                              FName & vbCrLf & vbCrLf & _
                              "Ensure the file is closed and you have the permissions to delete it.", _
                              vbRetryCancel, "File Delete Failed") = vbCancel Then
                        DeleteFile = False
                        Complete = True
                        Exit Function
                    End If
                Else
                    Complete = True
                End If
            Else
                Sleep 1000 ' wait for 1 second before trying again
            End If
        End If
    Loop
End Function

Sample Usage

Copy and paste the code above into a new standard code module
Create a new class module named "Class1"
Add these lines of code to Class1:
Property Get Msg() As String
Msg = "Hello, world"
End Property
Save the class module
Run the following in the immediate window to TURN ON the class's Predeclared ID attribute:
SetPredeclaredId "Class1", True
Run the following in the immediate window:
?Class1.Msg
Note that Hello, world is written to the immediate window
Run the following in the immediate window to TURN OFF the class's Predeclared ID attribute:
SetPredeclaredId "Class1", False
Run the following in the immediate window:
?Class1.Msg
Access raises an "Object required" error because the class no longer has the PredeclaredId attribute set

Miscellany

Stress Test

I tested this routine out on a class module with 60,000+ lines of code.

They were almost all comments, since I was just trying to stress test the routine and had no interest in writing that much executable code. The SetPredeclaredId procedure took a few seconds to run, but it ran without any problem (on a very fast computer with a very fast SSD).

Obligatory Warnings

Before running this code, you should make a backup of your Access application.

I tested this code and it gave me no problems. But any time you export and import chunks of code, you need to be wary of VBA corruption. I keep my Microsoft Access applications under strict version control, so I don't worry as much about corruption as those who don't.

On the off chance that this routine does cause a problem, you'll be glad you had a backup.

Referenced articles

Image by Caleb Jack from Pixabay

UPDATE [2022-10-11]: Switch to late-binding in FileExists() procedure for simpler copy-and-paste implementation of sample code (avoids need to add Microsoft Scripting Runtime via Tools > References...).