Pearson Software Consulting Services

    Saving And Retrieving Data With SetProp And GetProp

         Excel doesn't provide a mechanism for saving data independently of a workbook other than the registry. Regardless of how you attempt to save data -- a value in a cell, a defined name, a public variable, or a custom document property -- the workbook in which the data is saved must be open.  If you close the workbook, the data becomes inaccessible.  

However, using a few Windows API calls, you can store numeric information that will remain accessible as long as Excel is running, regardless of whether any particular workbook is open. The data is retained as long as Excel itself is open. This allows you to create some numeric data from one workbook and access that data from another workbook, even if the original workbook is closed. The data is destroyed when the Excel application is closed.  Note that you can save only Long type numeric data.

These procedures store information in a window's property list. You are not restricted to saving data in Excel's main window property list. You can also save property values in a UserForm window's property list. This allows you to create numeric properties for a UserForm at run time. No variables in the UserForm's code module need to be declared.

This is useful for saving information about a form's usage at run time, or saving per-session application-wide variables.

Below are five VBA functions to support a saving and retrieving data window's property list.

SetProperty
This sets a property name and its associated numeric value. If the property name does not exist, it is created. If the property name does exist, its associated value is updated to the new value provided to the procedure.

GetProperty
This gets the value associated with a property name .  It populates a supplied variable with the value, if it exists. This procedure returns True or False indicating whether the value was successfully retrieved. If it returns False, most likely the specified property does not exist, and the value variable is left unchanged.

GetAllProperties
This function populates an array listing all the properties' names and associated values for a specified window. This array contains instances a class named CPropType. This class module is included in the downloadable file. See the documentation in that procedures code listing for details about how to call this procedure.

PropertyExists
This returns True or False indicating whether the specified property exists.

RemoveProperty
This removes the property from the property list.

All of these procedures have an optional parameter called HWnd. If this parameter is omitted or is less than or equal to 0, property strings and values are stored in and retrieved from the Excel application's main window property list. You can use the HWnd parameter to store data in another window's property list, such as a user form. The GetHWndOfForm procedure can be used to retrieve the HWnd of a specific UserForm.

The complete VBA module is shown below. You download the module here or a complete workbook here.

Option Explicit
Option Compare Text

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' modGetSetProps
' By Chip Pearson, www.cpearson.com, chip@cpearson.com
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' This module contains functions for adding and retrieving property values (Long
' data types) of a window, typically the Excel application's main window. These
' values will remain accessible even when the workbook that created them is closed.
' They will be accessible from any code in any workbook as long as the window exists.
' Usually, you will want to use the Excel main application window (the default for all
' procedures) to store the properties. These properties will persist until Excel closes.
'
' Note that the property can contain only Long data values.
'
' This module contains the following Public procedures (not including Private
' support procedures):
'
'       GetAllProperties - This populates an array of CPropType classes,
'                          one instance for each property retrieved.
'                          See the documentation in this procedure for
'                          details about calling it.
'       GetProperty      - This procedure gets the value of the specified
'                          property.
'       RemoveProperty   - This procedure removes the property from the window's
'                          property list.
'       SetProperty      - This creates an new property or updates an existing
'                          property.
'       GetHWndOfForm    - This returns the HWnd of the UserForm that is passed
'                          in to the procedure. This is to be used if you are
'                          storing values in the UserForm window's property list.
'       GetNewCPropType  - This returns a New CPropType class instance. This
'                          procedure is intended to be used when calling these
'                          procedures for other VBProjects that reference this
'                          Project. If you import this module and the CPropType
'                          class into your project, you can create a new CPropType
'                          instance with the New keyword -- you don't need to
'                          use the GetNewCPropType function.
'
'       All of these procedures have an optional argument name HWnd. If this
'       argument is omitted or is <= 0, the properties are stored in the main
'       Excel application window's property list. If HWnd is included and is > 0,
'       the property  list for that window is used. If you want to store properties
'       in a UserForm's property list, you can call HWnd = GetHWndOfForm(UF:=YourFormName)
'       to retrieve the HWnd of the form, and pass that value in the HWnd parameter
'       to the various functions to set or retrieve the value.
'
' The following are the Private procedures that are used to support the Public
' procedures in this module. You don't need to access these Private procedures (that
' is why they are declared as Private). They are used to support the Public procedures.
'
'       IsArrayAllocated
'       IsArrayDynamic
'       IsArrayEmpty
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

    
Private Declare Function IsWindow Lib "user32" ( _
    ByVal HWnd As Long) As Long

Private Declare Function GetProp Lib "user32" Alias "GetPropA" ( _
    ByVal HWnd As Long, _
    ByVal lpString As String) As Long

Private Declare Function SetProp Lib "user32" Alias "SetPropA" ( _
    ByVal HWnd As Long, _
    ByVal lpString As String, _
    ByVal hData As Long) As Long

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _
    ByVal lpClassName As String, _
    ByVal lpWindowName As String) As Long

Private Declare Function RemoveProp Lib "user32" Alias "RemovePropA" ( _
    ByVal HWnd As Long, _
    ByVal lpString As String) As Long

Private Declare Function EnumProps Lib "user32.dll" Alias "EnumPropsA" ( _
    ByVal HWnd As Long, _
    ByVal lpEnumFunc As Long) As Long

''''''''''''''''''''''''''''''''''''''''''''''''
' Note: The Visual Studio 6 API Viewer program
' shows the lpString type as String, not Long.
' It is incorrect. lpString needs to be a Long.
''''''''''''''''''''''''''''''''''''''''''''''''
Private Declare Function LStrLen Lib "kernel32" Alias "lstrlenA" ( _
    ByVal lpString As Long) As Long
    
''''''''''''''''''''''''''''''''''''''''''''''''
' Note: The Visual Studio 6 API Viewer program
' shows the lpString2 type as String, not Long.
' It is incorrect.  lpString2 needs to be a Long.
''''''''''''''''''''''''''''''''''''''''''''''''
Private Declare Function LStrCpy Lib "kernel32.dll" Alias "lstrcpyA" ( _
      ByVal lpString1 As String, _
      ByVal lpString2 As Long) As Long
    
''''''''''''''''''''''''''''''''''''''''
' These two variables are used with the
' GetAllProperties procedure. See the
' documentation in GetAllProperties
' for details.
''''''''''''''''''''''''''''''''''''''''
Private ArrayNdx As Long
Private ListAllArray() As CPropType


''''''''''''''''''''''''''''''''''''''''
' These two variables are used with the
' PropertyExists procedure. See the
' documentation in PropertyExists
' procedure for details.
''''''''''''''''''''''''''''''''''''''''
Private PropertyToFind As String
Private PropertyFound As Boolean


Public Function GetNewCPropType() As CPropType
''''''''''''''''''''''''''''''''''''''''''''''''
' GetNewCPropType
' This returns a new instance of CPropType to the
' calling procedure. This is to be used when you are
' calling these procedures from another VBAProject
' that references this project. If you import this
' module and the CPropType class into your project,
' you can simply create a new class instance with
' the New keyword. E.g.,
'
'     Dim PT As CPropType
'     Set PT = New CPropType
'
' The Instancing property of CPropType is
' PublicNotCreatable, so another project can
' declare a variable of that type, but not create
' an instance of the class. This function creates
' and returns a new instance of CPropType. E.g.,
'
'     Dim PT As projGetSetProps.CPropType
'     Set PT = projGetSetProps.GetNewCPropType()
'
''''''''''''''''''''''''''''''''''''''''''''''''
    Set GetNewCPropType = New CPropType
End Function


Public Function SetProperty(PropertyName As String, PropertyValue As Long, _
        Optional HWnd As Long = 0) As Boolean
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' SetProperty
' This function adds a property entry named PropertyName with the value
' PropertyValue to the window indentified by HWnd. If HWnd is omitted or
' <= 0, it is added to the main Excel application window's property list.
' The function returns True if the operation was successful, or False
' if an error occurred.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim Res As Long
Dim DestHWnd As Long

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' If HWnd was omitted or <= 0, use the Excel main application
' window HWnd.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If HWnd <= 0 Then
    DestHWnd = FindWindow("XLMAIN", Application.Caption)
Else
    DestHWnd = HWnd
End If

If DestHWnd = 0 Then
    SetProperty = False
    Exit Function
End If

'''''''''''''''''''''''''''''''''''''''''''''
' Ensure PropertyName is not an empty string.
'''''''''''''''''''''''''''''''''''''''''''''
If Trim(PropertyName) = vbNullString Then
    SetProperty = False
    Exit Function
End If

'''''''''''''''''''''''''''''''''''''''''''''
' Ensure DestHWnd is an existing window.
'''''''''''''''''''''''''''''''''''''''''''''
If IsWindow(DestHWnd) = 0 Then
    SetProperty = False
    Exit Function
End If

Res = SetProp(HWnd:=DestHWnd, lpString:=PropertyName, hData:=PropertyValue)
If Res = 0 Then
    '''''''''''''''''''''
    ' An error occurred.
    '''''''''''''''''''''
    SetProperty = False
Else
    '''''''''''''''''''''
    ' Success.
    '''''''''''''''''''''
    SetProperty = True
End If

End Function

Public Function GetAllProperties(ResultArray As Variant, _
    Optional HWnd As Long = 0) As Long
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' GetAllProperties
' This procedure creates an array in ResultArray, each element of which
' is an instance of the CPropType class, containing the name and value
' of each property in the property list of the window specified by HWnd.
' If HWnd is omitted or <= 0, the main Excel application window's property
' list is used.
'
' ResultArray must be a dynamic, single-dimensional array. The existing
' contents of ResultArray will be destroyed.
'
' The function returns the number of elements added to ResultArray,
' or -1 if an error occurred. The calling procedure should declare
' a dynamic array of CPropType classes, each of which will store the
' name and value of a property:
'
'        Dim PropArray() As CPropType
'
' It should then pass that array to this procedure:
'
'        Dim Res As Long
'        Res = GetAllProperties(ResultArray:=PropArray, HWnd:=0)
'
' This procedure will Erase and then repopulate ResultArray with instances
' of CPropType objects. Upon return from this procedure, the calling
' procedure should then loop through the array:
'        If Res > 0 Then
'            For N = LBound(PropArray) To UBound(PropArray)
'                Debug.Print CStr(N), PropArray(N).Name, PropArray(N).Value
'            Next N
'        End If
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim Res As Long
Dim DestHWnd As Long
Dim Counter As Long
Dim Ndx As Long
Dim PT As CPropType

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' If HWnd was omitted or <= 0, use the Excel main application
' window HWnd.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If HWnd <= 0 Then
    DestHWnd = FindWindow("XLMAIN", Application.Caption)
Else
    DestHWnd = HWnd
End If

If DestHWnd = 0 Then
    GetAllProperties = -1
    Exit Function
End If

''''''''''''''''''''''''''''''''''
' Ensure ResultArray is an array.
''''''''''''''''''''''''''''''''''
If IsArray(ResultArray) = False Then
    GetAllProperties = -1
    Exit Function
End If

''''''''''''''''''''''''''''''''''
' Ensure ResultArray is dynamic.
''''''''''''''''''''''''''''''''''
If IsArrayDynamic(Arr:=ResultArray) = False Then
    GetAllProperties = -1
    Exit Function
End If

'''''''''''''''''''''''''''''''''''''''''''''
' Ensure DestHWnd is an existing window.
'''''''''''''''''''''''''''''''''''''''''''''
If IsWindow(DestHWnd) = 0 Then
    GetAllProperties = -1
    Exit Function
End If

'''''''''''''''''''''''''''''''''''''''''''''
' Erase the existing ListAllArray and set the
' ArrayNdx variable to 0.
''''''''''''''''''''''''''''''''''''''''''''''
Erase ListAllArray
Erase ResultArray
ArrayNdx = 0
'''''''''''''''''''''''''''''''''''''''''''''''
' Call EnumProps to get all the properties of
' DestHWnd's property list. Windows will call
' ProcEnumPropForListAll for each property
' in the window's property list.
'''''''''''''''''''''''''''''''''''''''''''''''
Res = EnumProps(HWnd:=DestHWnd, lpEnumFunc:=AddressOf ProcEnumPropForListAll)
''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Redim the ResultArray to the number of properties
' enumerated by EnumProps. Copy the array ListAllArray
' to ResultArray.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
If IsArrayAllocated(Arr:=ListAllArray) = True Then
    ReDim ResultArray(1 To UBound(ListAllArray))
    Set PT = New CPropType
    For Ndx = LBound(ListAllArray) To UBound(ListAllArray)
        Set PT = ListAllArray(Ndx)
        PT.Name = ListAllArray(Ndx).Name
        PT.Value = ListAllArray(Ndx).Value
        Set ResultArray(Ndx) = PT
    Next Ndx
End If
''''''''''''''''''''''''''''''''''''''''''''''''''
' If the array is allocated, we retrieved at least
' one property. Return the number of properties
' retrieved. If the array is not allocated, there
' were no properties to retrieve, so return 0.
''''''''''''''''''''''''''''''''''''''''''''''''''
If IsArrayAllocated(Arr:=ResultArray) = True Then
    GetAllProperties = UBound(ResultArray)
Else
    GetAllProperties = 0
End If


End Function


Public Function GetProperty(PropertyName As String, ByRef PropertyValue As Long, _
    Optional HWnd As Long = 0) As Boolean
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' GetProperty
' This function retrieves the value of PropertyName from
' the window specified by HWnd. If HWnd is omitted or <= 0,
' it looks in the main Excel application window's property
' list. It will place the value of the specified property
' in the variable passed as PropertyValue. You must pass
' a Long type of variable for PropertyValue.
' The function returns True if the operation was successful,
' or False if an error occurred. If an error occurs, the
' variable PropertyValue is left unchanged.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Dim Res As Long
Dim DestHWnd As Long

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' If HWnd was omitted or is <= 0, use the Excel main application
' window HWnd.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If HWnd <= 0 Then
    DestHWnd = FindWindow("XLMAIN", Application.Caption)
Else
    DestHWnd = HWnd
End If

'''''''''''''''''''''''''''''''''''''''''''''
' Ensure DestHWnd is an existing window.
'''''''''''''''''''''''''''''''''''''''''''''
If IsWindow(DestHWnd) = 0 Then
    GetProperty = False
    Exit Function
End If

'''''''''''''''''''''''''''''''''''''''''''''
' Ensure PropertyName is not an empty string.
'''''''''''''''''''''''''''''''''''''''''''''
If Trim(PropertyName) = vbNullString Then
    GetProperty = False
    Exit Function
End If

Res = GetProp(DestHWnd, PropertyName)
'''''''''''''''''''''''''''''''''''''
' GetProp will return 0 if an error
' occurred, but 0 may also be a valid
' property value. Test Err.LastDllError
' to see if an error occurred. If it
' indicates an error, it is most likely
' that the property doesn't exist
' (Err.LastDllError = 2).
'''''''''''''''''''''''''''''''''''''
If Err.LastDllError <> 0 Then
    GetProperty = False
Else
    PropertyValue = Res
    GetProperty = True
End If

End Function



Public Function PropertyExists(PropertyName As String, _
    Optional HWnd As Long = 0) As Boolean
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' PropertyExists
' This function returns True or False indicating whether the
' property with the string value PropertyName exists for the
' window specified in HWnd. If HWnd is omitted or <= 0, the
' main Excel application window's property list is searched.
' The function returns True if the property exists or False
' if the property does not exist or an error occurred.
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim Res As Long
Dim DestHWnd As Long

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' If HWnd was omitted or <= 0, use the Excel main application
' window HWnd.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If HWnd <= 0 Then
    DestHWnd = FindWindow("XLMAIN", Application.Caption)
Else
    DestHWnd = HWnd
End If


'''''''''''''''''''''''''''''''''''''''''''''
' Ensure DestHWnd is an existing window.
'''''''''''''''''''''''''''''''''''''''''''''
If IsWindow(DestHWnd) = 0 Then
    PropertyExists = False
    Exit Function
End If

''''''''''''''''''''''''''''''''''''''''''''''''''
' Set PropetyFound to False and set PropertyToFind
' the the property name we're looking for.
''''''''''''''''''''''''''''''''''''''''''''''''''
PropertyFound = False
PropertyToFind = PropertyName
Res = EnumProps(DestHWnd, AddressOf ProcEnumPropForFind)

If PropertyFound = True Then
    PropertyExists = True
Else
    PropertyExists = False
End If

End Function


Public Function RemoveProperty(PropertyName As String, _
    Optional HWnd As Long = 0) As Boolean
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' RemoveProperty
' This function removes the property named by PropertyName from the property
' list of the window specified by HWnd. If HWnd is omitted or <= 0, then
' main Excel application window's property list is used.
' The function returns True if the operation was successful, or False if
' an error occurred.
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim Res As Long
Dim DestHWnd As Long
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' If HWnd was omitted or <= 0, use the Excel main application
' window HWnd.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If HWnd <= 0 Then
    DestHWnd = FindWindow("XLMAIN", Application.Caption)
Else
    DestHWnd = HWnd
End If

'''''''''''''''''''''''''''''''''''''''''''''
' Ensure DestHWnd is an existing window.
'''''''''''''''''''''''''''''''''''''''''''''
If IsWindow(DestHWnd) = 0 Then
    RemoveProperty = False
    Exit Function
End If
'''''''''''''''''''''''''''''''''''''''''''''
' Ensure PropertyName is not an empty string.
'''''''''''''''''''''''''''''''''''''''''''''
If Trim(PropertyName) = vbNullString Then
    RemoveProperty = False
    Exit Function
End If

Res = RemoveProp(DestHWnd, PropertyName)
''''''''''''''''''''''''''''''''
' If PropertyName doesn't exist
' we'll get an error value in Res.
' We can safely ignore this error
' and return True.
''''''''''''''''''''''''''''''''
RemoveProperty = True
End Function

Public Function GetHWndOfForm(UF As Object) As Long
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' GetHWndOfForm
' This returns the HWnd of the UserForm referenced in UF.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Dim HWnd As Long
    HWnd = FindWindow("ThunderDFrame", UF.Caption)
    GetHWndOfForm = HWnd
End Function

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Private Support Procedures
' These functions are documented and available for download at
' http://www.cpearson.com/excel/vbaarrays.htm.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Private Function IsArrayAllocated(Arr As Variant) As Boolean
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' IsArrayAllocated
' Returns TRUE if the array is allocated (either a static array or a dynamic array that has been
' sized with Redim) or FALSE if the array is not allocated (a dynamic that has not yet
' been sized with Redim, or a dynamic array that has been Erased). Static arrays are always
' allocated.
'
' The VBA IsArray function indicates whether a variable is an array, but it does not
' distinguish between allocated and unallocated arrays. It will return TRUE for both
' allocated and unallocated arrays. This function tests whether the array has actually
' been allocated.
'
' This function is just the reverse of IsArrayEmpty.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Dim N As Long
On Error Resume Next

' if Arr is not an array, return FALSE and get out.
If IsArray(Arr) = False Then
    IsArrayAllocated = False
    Exit Function
End If

' Attempt to get the UBound of the array. If the array has not been allocated,
' an error will occur. Test Err.Number to see if an error occurred.
N = UBound(Arr, 1)
If (Err.Number = 0) Then
    ''''''''''''''''''''''''''''''''''''''
    ' Under some circumstances, if an array
    ' is not allocated, Err.Number will be
    ' 0. To acccomodate this case, we test
    ' whether LBound <= Ubound. If this
    ' is True, the array is allocated. Otherwise,
    ' the array is not allocated.
    '''''''''''''''''''''''''''''''''''''''
    If LBound(Arr) <= UBound(Arr) Then
        ' no error. array has been allocated.
        IsArrayAllocated = True
    Else
        IsArrayAllocated = False
    End If
Else
    ' error. unallocated array
    IsArrayAllocated = False
End If

End Function

Private Function IsArrayDynamic(ByRef Arr As Variant) As Boolean
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' IsArrayDynamic
' This function returns TRUE or FALSE indicating whether Arr is a dynamic array.
' Note that if you attempt to ReDim a static array in the same procedure in which it is
' declared, you'll get a compiler error and your code won't run at all.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Dim LUBound As Long

' If we weren't passed an array, get out now with a FALSE result
If IsArray(Arr) = False Then
    IsArrayDynamic = False
    Exit Function
End If

' If the array is empty, it hasn't been allocated yet, so we know
' it must be a dynamic array.
If IsArrayEmpty(Arr:=Arr) = True Then
    IsArrayDynamic = True
    Exit Function
End If

' Save the UBound of Arr.
' This value will be used to restore the original UBound if Arr
' is a single-dimensional dynamic array. Unused if Arr is multi-dimensional,
' or if Arr is a static array.
LUBound = UBound(Arr)

On Error Resume Next
Err.Clear

' Attempt to increase the UBound of Arr and test the value of Err.Number.
' If Arr is a static array, either single- or multi-dimensional, we'll get a
' C_ERR_ARRAY_IS_FIXED_OR_LOCKED error. In this case, return FALSE.
'
' If Arr is a single-dimensional dynamic array, we'll get C_ERR_NO_ERROR error.
'
' If Arr is a multi-dimensional dynamic array, we'll get a
' C_ERR_SUBSCRIPT_OUT_OF_RANGE error.
'
' For either C_NO_ERROR or C_ERR_SUBSCRIPT_OUT_OF_RANGE, return TRUE.
' For C_ERR_ARRAY_IS_FIXED_OR_LOCKED, return FALSE.

ReDim Preserve Arr(LBound(Arr) To LUBound + 1)

Select Case Err.Number
    Case 0
        ' We successfully increased the UBound of Arr.
        ' Do a ReDim Preserve to restore the original UBound.
        ReDim Preserve Arr(LBound(Arr) To LUBound)
        IsArrayDynamic = True
    Case 9
        ' Arr is a multi-dimensional dynamic array.
        ' Return True.
        IsArrayDynamic = True
    Case 10
        ' Arr is a static single- or multi-dimensional array.
        ' Return False
        IsArrayDynamic = False
    Case Else
        ' We should never get here.
        ' Some unexpected error occurred. Be safe and return False.
        IsArrayDynamic = False
End Select

End Function


Private Function IsArrayEmpty(Arr As Variant) As Boolean
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' IsArrayEmpty
' This function tests whether the array is empty (unallocated). Returns TRUE or FALSE.
'
' The VBA IsArray function indicates whether a variable is an array, but it does not
' distinguish between allocated and unallocated arrays. It will return TRUE for both
' allocated and unallocated arrays. This function tests whether the array has actually
' been allocated.
'
' This function is really the reverse of IsArrayAllocated.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Dim Var As Variant
Err.Clear
On Error Resume Next
If IsArray(Arr) = False Then
    ' we weren't passed an array, return True
    IsArrayEmpty = True
End If

' Attempt to get the UBound of the array. If the array is
' unallocated, an error will occur.
Var = UBound(Arr, 1)
If (Err.Number <> 0) Or (Var < 0) Then
    IsArrayEmpty = True
Else
    IsArrayEmpty = False
End If

End Function


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Windows Callback procedures for EnumProps
' These addresses of these procedures are passed to the EnumProps API function.
' Windows will call the procedure passed to EnumProps one time for each property
' in the specified window's property list. These procedures MUST be declared
' exactly as shown. If you change the declaration, you'll crash Excel.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Private Function ProcEnumPropForFind(ByVal HWnd As Long, ByVal Addr As Long, _
            ByVal Data As Long) As Boolean
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' ProcEnumPropForFind
' This is the Windows callback function for determining if a property exits.  It
' is called by Windows for each property in the property list. We test the string
' value provided to this procedure against the value of PropertyToFind. If we get
' a match, the property exists and the PropertyFound value is set to True, and
' we terminate the enumeration.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim StringName As String
Dim Res As Long
Dim SLen As Long
Dim Pos As Integer

'''''''''''''''''''''''''''''''
' Set the PropertyFound variable
' to False.
''''''''''''''''''''''''''''''''
PropertyFound = False

'''''''''''''''''''''''''''''''
' Get the length of the string
' stored at the address Addr.
' This length does not include
' the trailing null character.
'''''''''''''''''''''''''''''''
SLen = LStrLen(Addr)
'''''''''''''''''''''''''''''''
' Allocate the StringName buffer.
' The +1 is to make room for the
' trailing null character.
'''''''''''''''''''''''''''''''
StringName = String$(SLen + 1, vbNullChar)
'''''''''''''''''''''''''''''''''''
' Copy the string from Addr to the
' StringName buffer variable.
'''''''''''''''''''''''''''''''''''
Res = LStrCpy(ByVal StringName, Addr)
If Res = 0 Then
    Debug.Print "An error occurred with LStrCpy.", Err.LastDllError
Else
    '''''''''''''''''''''''''''''''''''''''
    ' Trim off the trailing null character.
    '''''''''''''''''''''''''''''''''''''''
    Pos = InStr(1, StringName, vbNullChar)
    If Pos > 0 Then
        StringName = Left(StringName, Pos - 1)
    End If
    ''''''''''''''''''''''''''''''''''''''
    ' Compare PropertyName to StringName.
    ' If they match, set PropertyFound
    ' to True and terminate the enumeration.
    ''''''''''''''''''''''''''''''''''''''
    If StrComp(PropertyToFind, StringName, vbTextCompare) = 0 Then
        PropertyFound = True
        ProcEnumPropForFind = False
        Exit Function
    End If
End If
'''''''''''''''''''''''''''''
' Return True to continue the
' enumeration.
'''''''''''''''''''''''''''''
ProcEnumPropForFind = True

End Function

Private Function ProcEnumProp(ByVal HWnd As Long, ByVal Addr As Long, _
            ByVal Data As Long) As Boolean
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' ProcEnumProp
' This is the callback function for EnumProps. Windows will call
' this function for each Property associated with the HWnd in the
' call to EnumProps.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim StringName As String
Dim Res As Long
Dim SLen As Long
Dim Pos As Integer

'''''''''''''''''''''''''''''''
' Get the length of the string
' stored at the address Addr.
' This length does not include
' the trailing null character.
'''''''''''''''''''''''''''''''
SLen = LStrLen(Addr)
'''''''''''''''''''''''''''''''
' Allocate the StringName buffer.
' The +1 is to make room for the
' trailing null character.
'''''''''''''''''''''''''''''''
StringName = String$(SLen + 1, vbNullChar)
'''''''''''''''''''''''''''''''''''
' Copy the string from Addr to the
' StringName buffer variable.
'''''''''''''''''''''''''''''''''''
Res = LStrCpy(ByVal StringName, Addr)
If Res = 0 Then
    Debug.Print "An error occurred with LStrCpy.", Err.LastDllError
Else
    '''''''''''''''''''''''''''''''''''''''
    ' Trim off the trailing null character.
    '''''''''''''''''''''''''''''''''''''''
    Pos = InStr(1, StringName, vbNullChar)
    If Pos > 0 Then
        StringName = Left(StringName, Pos - 1)
    End If
    Debug.Print CStr(Addr), StringName, CStr(Data)
End If
'''''''''''''''''''''''''''''
' Return True to continue the
' enumeration.
'''''''''''''''''''''''''''''
ProcEnumProp = True
End Function


Private Function ProcEnumPropForListAll(ByVal HWnd As Long, ByVal Addr As Long, _
            ByVal Data As Long) As Boolean
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' ProcEnumPropForListAll
' This is the Windows callback procedure for EnumProps called by GetAllProperties. It
' stores each property name and associated value in a CPropType class instance and
' adds that to the module-level variable ListAllArray. ListAllArray should be Erased
' and ArrayNdx set to 0 prior to calling the EnumProps API function that calls this
' function.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Dim StringName As String
Dim Res As Long
Dim SLen As Long
Dim Pos As Integer
Dim PropType As CPropType
'''''''''''''''''''''''''''''''''
' Get the length of the string.
' This length does not include
' the trailing null character.
'''''''''''''''''''''''''''''''''
SLen = LStrLen(Addr)
'''''''''''''''''''''''''''''''''
' Allocate StringName to SLen+1
' vbNullChars. The +1 is for the
' trailing null character.
'''''''''''''''''''''''''''''''''
StringName = String$(SLen + 1, vbNullChar)
'''''''''''''''''''''''''''''''''''''''
' Copy the string from the address Addr
' to the StringName buffer variable.
'''''''''''''''''''''''''''''''''''''''
Res = LStrCpy(ByVal StringName, Addr)
''''''''''''''''''''''''''''''''''''''
' Trim to the vbNullChar if necessary.
''''''''''''''''''''''''''''''''''''''
Pos = InStr(1, StringName, vbNullChar)
If Pos > 0 Then
    StringName = Left(StringName, Pos - 1)
End If
'''''''''''''''''''''''''''''''''''''''''
' Create a new instance of CPropType,
' increment the array index and resize
' the array. Set the last element of
' the array to the new CPropType variable.
'''''''''''''''''''''''''''''''''''''''''
Set PropType = New CPropType
ArrayNdx = ArrayNdx + 1
ReDim Preserve ListAllArray(1 To ArrayNdx)
PropType.Name = StringName
PropType.Value = Data
Set ListAllArray(UBound(ListAllArray)) = PropType

'''''''''''''''''''''''''''''
' Return True to continue the
' enumeration.
'''''''''''''''''''''''''''''
ProcEnumPropForListAll = True
End Function
 

 

Created By Chip Pearson and Pearson Software Consulting, LLC 
This Page:                Updated: November 06, 2013     
MAIN PAGE    About This Site    Consulting    Downloads  
Page Index     Search    Topic Index    What's New   
Links   Legalese And Disclaimers
chip@cpearson.com

© Copyright 1997-2007  Charles H. Pearson