mdlTEST

Option Explicit

Sub GetAllAddIns()
    Call GetCOMAddIns
    Call GetExcelAddIns
End Sub

' --------------------------------------------------
' Test cComAddIns
' --------------------------------------------------
Sub GetCOMAddIns()
    Dim ca As cComAddIns
    Dim a() As Variant
    Dim i As Long

    Set ca = New cComAddIns

    If ca.AddInsToArray(a, False) > 0 Then
        For i = LBound(a) To UBound(a)
            Debug.Print a(i, 2)
        Next i
    End If

    Worksheets("COM AddIns").Cells.ClearContents

    ca.AddInsToRange Worksheets("COM AddIns").Range("A2"), True

    Set ca = Nothing
End Sub


Sub GetProgIds()
    Dim ca As cComAddIns
    Dim a() As Variant
    Dim i As Long

    Set ca = New cComAddIns

    If ca.ProgIdsToArray(a) > 0 Then
        For i = LBound(a) To UBound(a)
            Debug.Print a(i)
        Next i
    End If

    ca.ProgIdsToRange Worksheets("Maintenance").Range("B2")

    Set ca = Nothing
End Sub



Sub Test_ComAddIn_Validate()
    Dim ca As cComAddIns
    Set ca = New cComAddIns

    Debug.Print ca.Validate(Range("COMAddIns"), True)

    Set ca = Nothing
End Sub



' --------------------------------------------------
' Test cAddIns
' --------------------------------------------------
Sub Test_AddIns_GetNames()
    Dim ai As cAddIns
    Dim a() As Variant
    Dim i As Long
    Set ai = New cAddIns

    If ai.AddInNamesToArray(a) > 0 Then
        For i = LBound(a) To UBound(a)
            Debug.Print a(i)
        Next i
    End If

    ai.AddInNamesToRange Worksheets("Maintenance").Range("B2")

    Set ai = Nothing
End Sub



Sub GetExcelAddIns()
    Dim ai As cAddIns
    Dim a() As Variant
    Dim i As Long
    Set ai = New cAddIns

    If ai.AddInsToArray(a, True) > 0 Then
        For i = LBound(a) To UBound(a)
            Debug.Print a(i, 2)
        Next i
    End If


    Worksheets("Excel AddIns").Cells.ClearContents
    ai.AddInsToRange Worksheets("Excel AddIns").Range("A2"), True

    Set ai = Nothing
End Sub


Sub Test_AddIn_IsInstalled()
    Dim ai As cAddIns
    Set ai = New cAddIns
    Dim status As AddInStatus

    status = ai.IsInstalled("BloombergUI.xla")
    '/status = ai.IsInstalled("EUROTOOL.XLAM")
    '/status = ai.IsInstalled("Yadda.xla")

    Debug.Print ai.IsInstalledToString(status)

    Set ai = Nothing
End Sub


' This uses the Excel AddIns names listed in the named range 'AddIns' and
' confirms each is installed and regietered.
' Any Excel AddIns in the list which are not INstalled *and* registered are
' displayed in a message.
Sub Test_AddIn_Validate()
    Dim status As AddInStatus

    Dim ai As cAddIns
    Set ai = New cAddIns

    Debug.Print ai.Validate(Range("AddIns"), True)

    Set ai = Nothing
End Sub

cAddIns

​Option Explicit

Private Const ModName As String = "cAddIns"


Public Enum AddInStatus
Unknown = 0
InstalledAndRegistered = 1
InstalledNotRegistered = 2
NotFound = 3
End Enum


' Validate:
' Loops the passed range of Excel AddIns names and confirms if each is
' installed *and* regietered.
' Any Excel AddIns in the list which are not Installed *and* registered
' are optionally displayed in a message.
'
' This allows you to abort a process if a required addin is not available
'
' > Validate Example:
'
' Dim status As AddInStatus
' Dim ai As cAddIns
'
' Set ai = New cAddIns
'
' If ai.Validate(Range("AddIns"), True) = False Then
' ' Abort process?
' End If
'
' Set ai = Nothing
'
Public Function Validate(ByRef AddInList As Range, ByVal DisplayMessage As Boolean) As Boolean
Const ProcName As String = "Validate"
On Error GoTo ErrorHandler

Dim status As AddInStatus
Dim ReturnValue As Boolean
Dim count As Long
Dim msg As String
Dim cell As Range

msg = "The following Excel Add-Ins are not available:" & vbCrLf & vbCrLf

For Each cell In AddInList.Cells
' ignore blank cells
If Len(cell.value) > 0 Then
status = Me.IsInstalled(cell.value)

If status <> AddInStatus.InstalledAndRegistered Then
count = count + 1
msg = msg & count & ") " & cell.value & vbCrLf
End If
End If
Next cell

If count > 0 Then
If DisplayMessage = True Then
MsgBox msg, vbInformation, AppName
End If
Else
ReturnValue = True
End If

ExitFunction:
Validate = ReturnValue
Exit Function

ErrorHandler:
log.LogError ThisWorkbook, ModName, ProcName, Err.Number, Err.Description, Erl
Resume ExitFunction

End Function



' AddInsToRange:
' Populates a range (starting from the Target cell) with a list of Excel Add-Ins
' (*not* COM Add-Ins) and attributes of each.
'
' > AddInsToArray Example:
'
' Dim ca As cComAddIns
' Set ca = New cComAddIns
'
' ca.AddInsToRange Range("A2"), True
'
' Set ca = Nothing
'
Public Function AddInsToRange(ByRef Target As Range, Optional IncludeHeadings As Boolean = False) As Boolean
Const ProcName As String = "AddInsToRange"
On Error GoTo ErrorHandler

Dim a() As Variant
Dim status As Boolean

If Me.AddInsToArray(a(), IncludeHeadings) > 0 Then
Target.Resize(UBound(a), UBound(a, 2)).value = a
End If

status = True

ExitFunction:
AddInsToRange = status
Exit Function

ErrorHandler:
log.LogError ThisWorkbook, ModName, ProcName, Err.Number, Err.Description, Erl
Resume ExitFunction

End Function





' AddInsToArray:
' Returns a 2D array with a list of Excel Add-Ins (*not* COM Add-Ins) and attributes of each.
'
' > AddInsToArray Example:
'
' Dim ca As cComAddIns
' Dim a() As Variant
' Dim i As Long
'
' Set ca = New cComAddIns
'
' If ca.AddInsToArray(a, False) > 0 Then
' For i = LBound(a) To UBound(a)
' Debug.Print a(i, 2)
' Next i
' End If
'
' Set ca = Nothing
'
Public Function AddInsToArray(ByRef data() As Variant, Optional IncludeHeadings As Boolean = False) As Long
Const ProcName As String = "AddInsToArray"
On Error GoTo ErrorHandler

Dim Target As Range
Dim ai As AddIn
Dim i As Long

Const ArrayColumns As Integer = 7

ReDim data(1 To Application.AddIns.count, 1 To ArrayColumns)

' If headings have been requested, increase the size of the output array
' and populated the first 'row' with field (column) names
If IncludeHeadings = True Then
i = i + 1
ReDim data(1 To (Application.AddIns.count + 1), 1 To ArrayColumns)

data(i, 1) = "Machine"
data(i, 2) = "Name"
data(i, 3) = "Installed"
data(i, 4) = "Is Open"
data(i, 5) = "File Version"
data(i, 6) = "File Date"
data(i, 7) = "Full Name"
End If


For Each ai In AddIns
i = i + 1
data(i, 1) = Environ("ComputerName")
data(i, 2) = ai.Name
data(i, 3) = ai.Installed
data(i, 4) = ai.IsOpen
data(i, 5) = FileVersion(ai.FullName)
data(i, 6) = FileDate(ai.FullName)
data(i, 7) = ai.FullName
Next ai

ExitFunction:
AddInsToArray = i
Exit Function

ErrorHandler:
i = 0
log.LogError ThisWorkbook, ModName, ProcName, Err.Number, Err.Description, Erl
Resume ExitFunction

End Function



' AddInNamesToRange:
' Populates a range (starting from the Target cell) with a list of Excel Add-Ins
' (*not* COM Add-Ins) and attributes of each.
'
' > AddInsToArray Example:
'
' Dim ca As cComAddIns
' Set ca = New cComAddIns
'
' ca.AddInNamesToRange Range("A2")
'
' Set ca = Nothing
'
Public Function AddInNamesToRange(ByRef Target As Range) As Boolean
Const ProcName As String = "AddInNamesToRange"
On Error GoTo ErrorHandler

Dim a() As Variant
Dim status As Boolean

If Me.AddInNamesToArray(a) > 0 Then
Target.Resize(UBound(a), 1).value = WorksheetFunction.Transpose(a)
End If

status = True

ExitFunction:
AddInNamesToRange = status
Exit Function

ErrorHandler:
log.LogError ThisWorkbook, ModName, ProcName, Err.Number, Err.Description, Erl
Resume ExitFunction

End Function




Public Function AddInNamesToArray(ByRef data() As Variant) As Long
Const ProcName As String = "AddInNamesToArray"
On Error GoTo ErrorHandler

Dim ai As AddIn
Dim i As Long

ReDim data(1 To Application.AddIns.count)

For Each ai In Application.AddIns
i = i + 1
data(i) = ai.Name
Next ai

ExitFunction:
AddInNamesToArray = i
Exit Function

ErrorHandler:
i = 0
log.LogError ThisWorkbook, ModName, ProcName, Err.Number, Err.Description, Erl
Resume ExitFunction

End Function



' IsInstalled:
' Returns one of the 'AddInStatus' Enum values indicating the install status of
' the passed Excel AddIn.
'
' > IsInstalled
' Dim ai As cAddIns
' Set ai = New cAddIns
' Dim status As AddInStatus
'
' status = ai.IsInstalled("BloombergUI.xla")
' Debug.Print ai.IsInstalledToString(status)
'
' Set ai = Nothing
'
Public Function IsInstalled(ByVal AddInName As String) As AddInStatus
Const ProcName As String = "IsConnected"
On Error GoTo ErrorHandler

Dim ai As AddIn
Dim status As AddInStatus

status = AddInStatus.NotFound

For Each ai In Application.AddIns

If ai.Name = AddInName Then
If ai.Installed = True Then
status = AddInStatus.InstalledAndRegistered
Else
status = AddInStatus.InstalledNotRegistered
End If

Exit For
End If

Next ai

ExitFunction:
Set ai = Nothing
IsInstalled = status
Exit Function

ErrorHandler:
log.LogError ThisWorkbook, ModName, ProcName, Err.Number, Err.Description, Erl
Resume ExitFunction

End Function


' Converts an ComAddInConnections Enum numerical value to a string.
'
Public Function IsInstalledToString(ByVal status As AddInStatus) As String
Dim value As String

Select Case status
Case AddInStatus.Unknown
value = "Unknown connection status"
Case AddInStatus.InstalledAndRegistered
value = "Installed and Registered"
Case AddInStatus.InstalledNotRegistered
value = "Installed but not Registered"
Case AddInStatus.NotFound
value = "AddIn Not Found"
Case Else
value = "Unknown Installation Type"
End Select

IsInstalledToString = value

End Function



' Uses File System Object to return the passed file's version number (if any)
'
Private Function FileVersion(ByVal FileName As String)
On Error GoTo ErrorHandler

Dim ver As String
Dim fso As Object ' FileSystemObject
Set fso = CreateObject("Scripting.FileSystemObject")

ver = fso.GetFileVersion(FileName)

If Len(ver) = 0 Then
ver = "No File Version"
End If

ExitFunction:
Set fso = Nothing
FileVersion = ver
Exit Function

ErrorHandler:
ver = "Can't get File Version"
Resume ExitFunction

End Function


' Returns the passed file's last modified or creation date
'
Private Function FileDate(ByVal FileName As String)
On Error Resume Next
Dim dte As String
dte = FileDateTime(FileName)

If Len(dte) = 0 Then
dte = "Unknown Date"
End If

FileDate = dte

End Function

cComAddIns

Option Explicit
Option Compare Text

Private Const ModName As String = "cComAddIns"

' cComAddIns


' Sections of code to determnine the DLL file name of a COM AddIn (based on the progID) were sourced from:
' https://www.cpearson.com/excel/DLLNameOfComAddin.htm

' This function takes as its input parameter a reference to an existing COM AddIn
' and returns a string containing the fully-qualified DLL file name of that COM Add-In.
' The COM Addin need not be connected.
'
' This module is entirely self-contained. It requires no additional support code.
' This code may be in any Office application that supports VBA6 (Office 2000 and later).


Public Enum ComAddInStatus
Unknown = 0
InstalledConnected = 1
InstalledNotConnected = 2
NotFound = 3
End Enum


' -- Constants

' Misc constants.
Private Const C_COM_ADDIN_CLSID_REG_LOCATION = "SOFTWARE\Classes\CLSID\"
Private Const C_COM_ADDIN_CLSID_REG_VALUE_NAME = "InprocServer32"
Private Const C_PATH_SEPARATOR = "\"
Private Const ERROR_SUCCESS As Long = 0

' Windows mandated value.
Private Const MAX_PATH As Long = 260

' Registry Sections
Private Const HKEY_LOCAL_MACHINE As Long = &H80000002



' -- Windows API DeclarATIONS
'
' RegOpenKey opens an existing registry key, named in lpSubKey. It populates
' phkResult with a key value that is used by the other registry functions.
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" _
(ByVal hKey As Long, ByVal lpSubKey As String, ByRef phkResult As Long) As Long

' RegCloseKey closes a registry key previously opened with RegOpenKey.
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long

' RegQueryValue reads the value of a registry item, opened with RegOpenKey.
Private Declare Function RegQueryValue Lib "advapi32.dll" Alias "RegQueryValueA" _
(ByVal hKey As Long, ByVal lpSubKey As String, _
ByVal lpValue As String, ByRef lpcbValue As Long) As Long




Public Function Description(ByVal AddInProgId As String) As String
Const ProcName As String = "Description"
On Error GoTo ErrorHandler

Dim c As ComAddIn
Dim value As String

Set c = Application.COMAddIns(AddInProgId)

value = c.Description

ExitFunction:
Set c = Nothing
Description = value
Exit Function

ErrorHandler:
Select Case Err.Number
Case 9 ' Subscript out of range
value = "COM AddIn Not Found"
Case Else
log.LogError ThisWorkbook, ModName, ProcName, Err.Number, Err.Description, Erl
End Select

Resume ExitFunction

End Function




Public Function FileName(ByVal AddInProgId As String) As String
Const ProcName As String = "FileName"
On Error GoTo ErrorHandler

Dim c As ComAddIn
Dim value As String

Set c = Application.COMAddIns(AddInProgId)
value = ComAddInFile(c)

ExitFunction:
Set c = Nothing
FileName = value
Exit Function

ErrorHandler:
Select Case Err.Number
Case 9 ' Subscript out of range
value = "COM AddIn Not Found"
Case Else
log.LogError ThisWorkbook, ModName, ProcName, Err.Number, Err.Description, Erl
End Select

Resume ExitFunction

End Function





' This function returns the fully-qualified name of the DLL file for the
' specified COM Add-In (CAI).
' ComAddIn is a reference to an existing CAI.
' It is not required that the AddIn be connected.
Public Function ComAddInFile(ComAddIn As Office.ComAddIn) As String
Const ProcName As String = "ComAddInFile"
On Error GoTo ErrorHandler

Dim RegistryKeyName As String ' stores the name of the registry key we're working with
Dim RegResult As String ' stores the name of the COM Add-In's DLL file.
Dim Res As Long ' general puprose return code variable
Dim RegKey As Long ' internal registry key value retrieved by RegOpenKey
Dim ErrorNumber As Long ' stores the error number than may have occurred
Dim RegResultLen As Long ' length in characters of RegResult


' Initialize the string we're going to populate with the DLL name.
' The buffer must be long enough to store the complete DLL file name.
' MAX_PATH is a Windows mandated length, the maximum length of a fully qualified file name.
RegResult = String$(MAX_PATH, vbNullChar)


' ensure we didn't get NOTHING
If ComAddIn Is Nothing Then
MsgBox "The ComAddIn parameter is NOTHING."
GoTo ExitFunction
End If


' Initialise the registry key name. It will contain a string similar to:
'
' SOFTWARE\Classes\CLSID\{F0E54810-A875-4C54-9697-0AE40DAA7316}\InprocServer32
'
' We will look up this key in the HKEY_LOCAL_MACHINE section
' of the registry.
RegistryKeyName = C_COM_ADDIN_CLSID_REG_LOCATION & ComAddIn.GUID & _
C_PATH_SEPARATOR & C_COM_ADDIN_CLSID_REG_VALUE_NAME


' Open the registry key RegistryKeyName.
' RegOpenKey puts in RegKey a key value that is used by all other
' registry functions that access that key.
Res = RegOpenKey(hKey:=HKEY_LOCAL_MACHINE, _
lpSubKey:=RegistryKeyName, phkResult:=RegKey)

If Res <> ERROR_SUCCESS Then
ErrorNumber = Res
RegResult = "Couldn't open the registry key."
'/Debug.Print RegResult & ": " & RegistryKeyName & " for " & ComAddIn.progID
GoTo ExitFunction
End If


' Get the value from the registry.
' Set lpSubKey:=vbNullString to get the default value, which is the DLL file name.

' RegResultLen is the length in characters of RegResult,
' the variable that will receive the DLL file name.
RegResultLen = MAX_PATH
Res = RegQueryValue(hKey:=RegKey, lpSubKey:=vbNullString, _
lpValue:=RegResult, lpcbValue:=RegResultLen)

If Res <> ERROR_SUCCESS Then
ErrorNumber = Res
RegResult = "Couldn't open the registry key."
RegCloseKey hKey:=RegKey
GoTo ExitFunction
End If


' close our registry key
RegCloseKey RegKey

' trim RegResult to the vbNullChar
RegResult = TrimNull(RegResult)

ExitFunction:
' return the DLL file name
ComAddInFile = RegResult
Exit Function

ErrorHandler:
log.LogError ThisWorkbook, ModName, ProcName, Err.Number, Err.Description, Erl
Resume ExitFunction

End Function




' TrimToNull
' This function returns the portion of Text that is to the left of the vbNullChar
' character (same as Chr(0)). Typically, this function is used with strings
' populated by Windows API procedures. It is generally not used for
' native VB Strings.
' If vbNullChar is not found, the entire Text string is returned.
Private Function TrimNull(Text As String) As String
Dim Pos As Integer

Pos = InStr(1, Text, vbNullChar)

If Pos > 0 Then
TrimNull = Left(Text, Pos - 1)
Else
TrimNull = Text
End If

End Function




' Validate:
' Loops the passed range of Excel AddIns names and confirms if each is
' installed *and* regietered.
' Any Excel AddIns in the list which are not Installed *and* registered
' are optionally displayed in a message.
'
' This allows you to abort a process if a required addin is not available
'
' > Validate Example:
'
' Dim ca As cComAddIns
' Set ca = New cComAddIns
'
' If ca.Validate(Range("COMAddIns"), True) = False Then
' ' Abort process?
' End If
'
' Set ca = Nothing
'
Public Function Validate(ByRef AddInList As Range, ByVal DisplayMessage As Boolean) As Boolean
Const ProcName As String = "Validate"
On Error GoTo ErrorHandler

Dim ReturnValue As Boolean
Dim status As ComAddInStatus
Dim msg As String
Dim cell As Range
Dim count As Long

msg = "The following COM Add-Ins are not available:" & vbCrLf & vbCrLf

For Each cell In Range("COMAddIns").Cells
' ignore blank cells
If Len(cell.value) > 0 Then
status = Me.IsConnected(cell.value)

If status <> InstalledConnected Then
count = count + 1
msg = msg & count & ") " & cell.value & vbCrLf
End If
End If
Next cell


If count > 0 Then
If DisplayMessage = True Then
MsgBox msg, vbInformation, AppName
End If
Else
ReturnValue = True
End If

ExitFunction:
Validate = ReturnValue
Exit Function

ErrorHandler:
log.LogError ThisWorkbook, ModName, ProcName, Err.Number, Err.Description, Erl
Resume ExitFunction

End Function



' Returns an array populated with a list of COM AddIns installed the current PC.
' Also returns the connect status of each COM Add-In.
' Optionally includes the columns headings in the array (usefule for pasting to a range.
Public Function AddInsToRange(ByRef Target As Range, Optional IncludeHeadings As Boolean = False) As Long
Const ProcName As String = "AddInsToRange"
On Error GoTo ErrorHandler

Dim a() As Variant
Dim status As Boolean

If Me.AddInsToArray(a, IncludeHeadings) > 0 Then
Target.Resize(UBound(a), UBound(a, 2)).value = a
End If

status = True

ExitFunction:
AddInsToRange = status
Exit Function

ErrorHandler:
log.LogError ThisWorkbook, ModName, ProcName, Err.Number, Err.Description, Erl
log.ShowMessage Err, ModName, ProcName, Erl
Resume ExitFunction

End Function




Public Function ProgIdsToRange(ByRef Target As Range) As Boolean
Const ProcName As String = "ProgIdsToRange"
On Error GoTo ErrorHandler

Dim status As Boolean
Dim a() As Variant

If Me.ProgIdsToArray(a) > 0 Then
Target.Resize(UBound(a), 1).value = WorksheetFunction.Transpose(a)
status = True
End If

ExitFunction:
ProgIdsToRange = status
Exit Function

ErrorHandler:
log.LogError ThisWorkbook, ModName, ProcName, Err.Number, Err.Description, Erl
log.ShowMessage Err, ModName, ProcName, Erl
Resume ExitFunction

End Function



Public Function ProgIdsToArray(ByRef data() As Variant) As Long
Const ProcName As String = "ProgIdsToArray"
On Error GoTo ErrorHandler

Dim c As ComAddIn
Dim i As Long

ReDim data(1 To Application.COMAddIns.count)

For Each c In Application.COMAddIns
i = i + 1
data(i) = c.progID
Next c

ExitFunction:
ProgIdsToArray = i
Exit Function

ErrorHandler:
log.LogError ThisWorkbook, ModName, ProcName, Err.Number, Err.Description, Erl
log.ShowMessage Err, ModName, ProcName, Erl
Resume ExitFunction

End Function



' Returns an array populated with a list of COM AddIns installed the current PC.
' Also returns the connect status of each COM Add-In.
' Optionally includes the columns headings in the array (usefule for pasting to a range.
Public Function AddInsToArray(ByRef data() As Variant, Optional IncludeHeadings As Boolean = False) As Long
Const ProcName As String = "AddInsToArray"
On Error GoTo ErrorHandler

Dim c As ComAddIn
Dim FileName As String
Dim i As Long

Const ArrayColumns As Integer = 8

' a(Rows, Colouns)
ReDim data(1 To Application.COMAddIns.count, 1 To ArrayColumns)

' If headings have been requested, increase the size of the output array
' and populated the first 'row' with field (column) names
If IncludeHeadings = True Then
i = i + 1
ReDim data(1 To (Application.COMAddIns.count + 1), 1 To ArrayColumns)

data(i, 1) = "Machine"
data(i, 2) = "Description"
data(i, 3) = "Connection"
data(i, 4) = "File Version"
data(i, 5) = "File Date"
data(i, 6) = "GUID"
data(i, 7) = "ProgID"
data(i, 8) = "File Name"
End If


For Each c In Application.COMAddIns
i = i + 1
FileName = Me.ComAddInFile(ComAddIn:=c)

data(i, 1) = Environ("ComputerName")
data(i, 2) = c.Description
data(i, 3) = Me.IsConnectedToString(Me.IsConnected(c.progID))
data(i, 4) = FileVersion(FileName)
data(i, 5) = FileDate(FileName)
data(i, 6) = c.GUID
data(i, 7) = c.progID
data(i, 8) = FileName
Next c


ExitFunction:
AddInsToArray = i
Exit Function

ErrorHandler:
i = 0
log.LogError ThisWorkbook, ModName, ProcName, Err.Number, Err.Description, Erl
Resume ExitFunction

End Function




' Determines if the nominated COM AddIn (based on the AddIn's progID) is connected.
' Returns a value in the ComAddInConnections enumerator.
' The default value is Enum 'Unknown'.
' If the passed progID is not recognised, this will return Enum 'NotFound'
'
Public Function IsConnected(ByVal AddInProgId As String) As ComAddInStatus
Const ProcName As String = "IsConnected"
On Error GoTo ErrorHandler

Dim c As ComAddIn
Dim status As ComAddInStatus

status = ComAddInStatus.Unknown
Set c = Application.COMAddIns(AddInProgId)

If c.Connect = True Then
status = ComAddInStatus.InstalledConnected
Else
status = ComAddInStatus.InstalledNotConnected
End If

ExitFunction:
Set c = Nothing
IsConnected = status
Exit Function

ErrorHandler:
Select Case Err.Number
Case 9 ' Subscript out of range
status = ComAddInStatus.NotFound
Case Else
log.LogError ThisWorkbook, ModName, ProcName, Err.Number, Err.Description, Erl
End Select

Resume ExitFunction

End Function


' Converts an ComAddInConnections Enum numerical value to a string.
'
Public Function IsConnectedToString(ByVal status As ComAddInStatus) As String
Dim value As String

Select Case status
Case Unknown
value = "Unknown connection status"
Case InstalledConnected
value = "Connected"
Case InstalledNotConnected
value = "Not Connected"
Case NotFound
value = "AddIn Not Found"
Case Else
value = "Unknown connection type"
End Select

IsConnectedToString = value

End Function



' Uses File System Object to return the passed file's version number (if any)
'
Private Function FileVersion(ByVal FileName As String) As String
On Error GoTo ErrorHandler

Dim ver As String
Dim fso As Object ' FileSystemObject
Set fso = CreateObject("Scripting.FileSystemObject")

ver = fso.GetFileVersion(FileName)

If Len(ver) = 0 Then
ver = "No File Version"
End If

ExitFunction:
Set fso = Nothing
FileVersion = ver
Exit Function

ErrorHandler:
ver = "Can't get File Version"
Resume ExitFunction

End Function


' Returns the passed file's last modified or creation date
'
Private Function FileDate(ByVal FileName As String) As String
On Error Resume Next
Dim dte As String
dte = FileDateTime(FileName)

If Len(dte) = 0 Then
dte = "Unknown Date"
End If

FileDate = dte

End Function

Worksheets

Excel AddIns

COM AddIns