Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Check If Class Module Exists and Check Version by Class name?

Status
Not open for further replies.

lameid

Programmer
Jan 31, 2001
4,207
US
I have some code the manages versions of some objects centrally.

One assumption I have is that every module I have as a public procedure that that gives the version back to a passed variable as called by fnModuleVersion below.

It works well. However I want to do the same with Class modules... They simply do not seem to exist in the AllModules collection for my ModuleExists function.

So I have two separate problems.

One, how do I detect if a class module exists in a database given its name?
Two, how do I return a classes version - I think instantiate it and check its particular name but how would I instantiate an instance given just the class name as a parameter? Actually an error handler and code to instantiate a class that way may solve both problems effectively...

In my model some modules are standard and can be centrally managed while others are project dependent. I'm not excited about the methodology as it suggests there should be one central code base running everything, which is likely accurate but also long, long way off. People don't like change and I don't have the time for them to make it my problem...

Code:
Public Function fnModuleVersion(ModuleName As String) As Long
  Dim strCallName As String
  Dim Obj As Object
  On Error GoTo fnModuleVersion_err
  
  strCallName = ModuleName & "Version"
  Application.Run strCallName, fnModuleVersion 'fnModuleVersion is this function variable passed as a byRef Arg to be returned as the function return
Exit Function

fnModuleVersion_err:
  Select Case Err.Number
    Case 2517 '<Project Name> cannot find the procedure <ModuleName & "Version">
      If ModuleExists(ModuleName) Then
        fnModuleVersion = 0 'Module Exists standard procedure does not... Likely a different animal
      Else
        fnModuleVersion = -1 'Module does not even exist in project... Likely don't need it?
      End If
    Case Else
      MsgBox "Unhandled Error in fnModuleVersion" & vbCrLf & "Error " & Err.Number & ": " & Err.Description, vbCritical
  End Select
End Function



Public Function ModuleExists(ModuleName As String, Optional ByRef varReturn As Variant) As Boolean
    'Determines if Module exists in current project
    'Keeps Track of module names between calls to prevent iterative scans of AllModules collection
    'Assumption here is that this will be called repeatedly once called otherwise loading all module names
      'to a static array would be an unecessary step and waste of memory.
    
    Dim proj As Object
    Dim aObj As AccessObject
    
    Dim i As Long
    Static strModuleNames() As String
    Dim lngModuleNamesUpper As Long
    Static lngModuleNamesUpperPrev As Long
    
    Set proj = CurrentProject()
    lngModuleNamesUpper = proj.AllModules.Count - 1
    
    If lngModuleNamesUpperPrev < lngModuleNamesUpper Then
      lngModuleNamesUpperPrev = lngModuleNamesUpper
      ReDim strModuleNames(lngModuleNamesUpper)

      i = 0
      For Each aObj In proj.AllModules
        strModuleNames(i) = aObj.Name
        i = i + 1
      Next aObj
    End If
    
    i = 0
    ModuleExists = False
    
    While i <= lngModuleNamesUpper
      If strModuleNames(i) = ModuleName Then
        ModuleExists = True
        i = lngModuleNamesUpper 'Force exit of loop after iterator is incremented once more
      End If
      i = i + 1
    Wend
    varReturn = strModuleNames()
End Function
 
I'm not sure how WizHook works under different protection and security settings, but if it works, you could try for all your requirements:
Code:
Dim VBproj
WizHook.Key = 51488399
Set VBproj = WizHook.DbcVbProject
' work as with VBIDE.VBProject, without referencing the library
' return module name or subscript out of range RT error
' vbcomponents accepts index (1-based) too
MsgBox VBproj.vbcomponents("Class1").Name
MsgBox VBproj.vbcomponents("Module1").Name
' return module type, 1 - standard module, 2 - class module (VBIDE component types)
MsgBox VBproj.vbcomponents("Class1").Type
MsgBox VBproj.vbcomponents("Module1").Type
' return single line of code starting from second line
MsgBox VBproj.vbcomponents("Class1").CodeModule.Lines(2, 1)
MsgBox VBproj.vbcomponents("Module1").CodeModule.Lines(2, 1)
' count vbcomponents in vbproject
MsgBox VBproj.vbcomponents.Count


combo
 
That looks interesting... New to me. What does the Wizhook.Key do? Does that have to do with configuring for MSAccess?
 
And suddenly, after a 15 year break from the site, wizhook is all over the place ... :)
 
Display hidden members in Object Browser, Access library, you can find the WizHook class here. The above key value unlocks some WizHook properties and functions. Old MS hack, I have it still in access 2016.

combo
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top