[V8i-SS2 VBA] reading variable from un-opened VBA Projects

Hi Folks,

I am writing a utility to  read utility versions for all my MVBA Projects. Will I need to open all in this code in order to do this?

I have highlighted where I got to so far.

 

' ---------------------------------------------------------------------
'   GetToolVersions
'   Lists all strVERSION values for all MVBA Utilities
'
'   Set a reference to the Microsoft Visual Basic for Applications
'   Extensibility 5.3 library (in Tools | References...)
'   VBIDE is the code name of this library.
' ---------------------------------------------------------------------
Public Sub GetToolVersions()
    '   Check for KeyinArguments
    Dim args()              As String
    Dim nArgs               As Integer
    args = Split(application.KeyinArguments, ",")
    nArgs = 1 + UBound(args) - LBound(args)
    If (1 < nArgs) Then
        Dim UName           As String
        Dim PWord           As String
        UName = args(1)
        PWord = args(2)
    Else
        '   Wrong number of arguments
    End If
   
    '   Prepare code project definitions
    Dim oVBE                As VBIDE.VBE
    Set oVBE = VBE
    Dim oProject            As VBIDE.VBProject
    Dim oProjects           As VBIDE.VBProjects
    Set oProjects = VBE.VBProjects
    Dim vbaAutoloads        As String
    Dim vbaProjects()       As String
    '   VBA requires the following as a variant and not a string
    Dim vbaProject          As Variant
   
    '   Get an array of AutoLoad VBA Project Names
    With ActiveWorkspace
        If .IsConfigurationVariableDefined("MS_VBAAUTOLOADPROJECTS") Then
            vbaAutoloads = .ConfigurationVariableValue("MS_VBAAUTOLOADPROJECTS", True)
        End If
        If .IsConfigurationVariableDefined("MS_VBAREQUIREDPROJECTS") Then
            vbaAutoloads = vbaAutoloads & ";" & .ConfigurationVariableValue("MS_VBAREQUIREDPROJECTS", True)
        End If
    End With
    vbaProjects = Split(vbaAutoloads, ";")
   
    '   Check each VBA project from list of AutoLoad VBA's
    Dim Count               As Long
    For Each vbaProject In vbaProjects
        '   Get MVBA as path and fullname
        Dim strName         As String
        Dim arrNames()      As String
        Dim intIndex        As Integer
        Dim PrjName         As String
        Dim strVersion      As String
        strName = vbaProjects(Count)
        arrNames = Split(strName, "\")
        intIndex = UBound(arrNames)
        PrjName = arrNames(intIndex)
        Debug.Print "File name: " & PrjName
        '   Get Procedure > Module constant strVERSION
        Dim oProj As VBProject
        Set oProj = vbaProject
        strVersion = oProj.EE_Header.strVersion
        Debug.Print "Version: " & strVersion
        Count = 1 + Count
    Next vbaProject
End Sub

Parents
  • Hi,

    when I needed something similar, I have used following code. It uses VBA project events OnProjectLoad/OnProjectUnload to add/remove unique configuration variable with name of my project. Then it is easy to list all my loaded VBA tools.

    Option Explicit

    ' Some native declarations
    Declare Function mdlSystem_getCfgVarByIndex Lib "stdmdlbltin.dll" ( _
      ByRef name As LongByRef translation As LongByRef level As Long, _
      ByRef lock_ As LongByVal index As LongAs Long

    Private Declare Function lstrlen Lib "kernel32.dll" Alias "lstrlenA" ( _
      ByVal lpString As LongAs Long

    Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" ( _
      Destination As Any, Source As Any, ByVal Length As Long)
      
    Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
    Private Declare Function GetTickCount Lib "kernel32" () As Long

    Dim my_project_id As Long

    ' implement this method for each project
    Public Sub OnProjectLoad(Optional dummy As Boolean)
      Sleep 50
      my_project_id = GetTickCount()
      Dim cfg_name As String
      cfg_name = "_VBA_PROJECT_" & my_project_id
      ActiveWorkspace.AddConfigurationVariable cfg_name, "Project Counter"False
    End Sub

    ' implement this method for each project
    Public Sub OnProjectUnload(Optional dummy As Boolean)
      Dim cfg_name As String
      cfg_name = "_VBA_PROJECT_" & my_project_id
      ActiveWorkspace.RemoveConfigurationVariable cfg_name
    End Sub

    ' get VBA string from C string pointer
    Public Function StrFromPtr(ByVal lpStr As LongAs String
     Dim bStr() As Byte
     Dim cChars As Long
     On Error Resume Next
     ' Get the number of characters in the buffer
     cChars = lstrlen(lpStr)
     If cChars Then
      ' Resize the byte array
      ReDim bStr(0 To cChars - 1As Byte
      ' Grab the ANSI buffer
      Call CopyMemory(bStr(0), ByVal lpStr, cChars)
     End If
     ' Now convert to a VB Unicode string
     StrFromPtr = StrConv(bStr, vbUnicode)
    End Function

    Public Sub CountOpenProjects()
      Dim i As Long
      Dim cfg_name As String
      Dim cfg_val As String
      Dim cfg_name_ptr As Long
      Dim cfg_val_ptr As Long
      Dim cfg_level As Long
      Dim cfg_lock As Long
      
      i = 0
      While (0 = mdlSystem_getCfgVarByIndex( _
        cfg_name_ptr, cfg_val_ptr, cfg_level, cfg_lock, i))
        
        cfg_name = StrFromPtr(cfg_name_ptr)
        'Debug.Print cfg_name
        If cfg_name Like "_VBA_PROJECT_*" Then
          cfg_val = StrFromPtr(cfg_val_ptr)
          Debug.Print cfg_val
        End If
        
        i = i + 1
      Wend
      
    End Sub
Reply
  • Hi,

    when I needed something similar, I have used following code. It uses VBA project events OnProjectLoad/OnProjectUnload to add/remove unique configuration variable with name of my project. Then it is easy to list all my loaded VBA tools.

    Option Explicit

    ' Some native declarations
    Declare Function mdlSystem_getCfgVarByIndex Lib "stdmdlbltin.dll" ( _
      ByRef name As LongByRef translation As LongByRef level As Long, _
      ByRef lock_ As LongByVal index As LongAs Long

    Private Declare Function lstrlen Lib "kernel32.dll" Alias "lstrlenA" ( _
      ByVal lpString As LongAs Long

    Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" ( _
      Destination As Any, Source As Any, ByVal Length As Long)
      
    Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
    Private Declare Function GetTickCount Lib "kernel32" () As Long

    Dim my_project_id As Long

    ' implement this method for each project
    Public Sub OnProjectLoad(Optional dummy As Boolean)
      Sleep 50
      my_project_id = GetTickCount()
      Dim cfg_name As String
      cfg_name = "_VBA_PROJECT_" & my_project_id
      ActiveWorkspace.AddConfigurationVariable cfg_name, "Project Counter"False
    End Sub

    ' implement this method for each project
    Public Sub OnProjectUnload(Optional dummy As Boolean)
      Dim cfg_name As String
      cfg_name = "_VBA_PROJECT_" & my_project_id
      ActiveWorkspace.RemoveConfigurationVariable cfg_name
    End Sub

    ' get VBA string from C string pointer
    Public Function StrFromPtr(ByVal lpStr As LongAs String
     Dim bStr() As Byte
     Dim cChars As Long
     On Error Resume Next
     ' Get the number of characters in the buffer
     cChars = lstrlen(lpStr)
     If cChars Then
      ' Resize the byte array
      ReDim bStr(0 To cChars - 1As Byte
      ' Grab the ANSI buffer
      Call CopyMemory(bStr(0), ByVal lpStr, cChars)
     End If
     ' Now convert to a VB Unicode string
     StrFromPtr = StrConv(bStr, vbUnicode)
    End Function

    Public Sub CountOpenProjects()
      Dim i As Long
      Dim cfg_name As String
      Dim cfg_val As String
      Dim cfg_name_ptr As Long
      Dim cfg_val_ptr As Long
      Dim cfg_level As Long
      Dim cfg_lock As Long
      
      i = 0
      While (0 = mdlSystem_getCfgVarByIndex( _
        cfg_name_ptr, cfg_val_ptr, cfg_level, cfg_lock, i))
        
        cfg_name = StrFromPtr(cfg_name_ptr)
        'Debug.Print cfg_name
        If cfg_name Like "_VBA_PROJECT_*" Then
          cfg_val = StrFromPtr(cfg_val_ptr)
          Debug.Print cfg_val
        End If
        
        i = i + 1
      Wend
      
    End Sub
Children
No Data