Pearson Software Consulting Services

    Getting the DLL Name From A COM Add-In

         Neither Excel nor VBA provides you with a method to get the DLL name of a COM Add-In. This page contains a procedure
named DLLOfComAddin that will return the fully-qualified file name of the DLL of the COM Add-In you pass in as a parameter. 
Since this code deals with COM Add-Ins, it will not work in Office97. This code can be used in any application that supports
VBA6 (Office 2000 and later) and COM Add-Ins. There is nothing specific to Excel in the code.

The procedure gets the GUID property of the passed-in COM Add-In reference and looks up that value in the appropriate key of the
Registry and returns the value of the InprocServer32 item.  The complete VBA module, including required constants and
Windows API declarations, is below.

This code uses the functions TrimToNull located here and  GetSystemErrorMessageText located here.

To get the DLL name of the COM Add-In, use code like the following:

Sub AAATest()
    Dim CAI As Office.COMAddIn
    Dim DLLName As String
   
Set CAI = Application.COMAddIns(1)
    DLLName = DLLOfComAddin(A_7_AB_1_ComAddIn:=CAI)
    If DLLName <> vbNullString Then
        MsgBox "Addin Information:" & vbCrLf & _
               "ProgID:   " & CAI.ProgID & vbCrLf & _
               "GUID:     " & CAI.GUID & vbCrLf & _
               "DLL Name: " & DLLName
    End If
End Sub


The Code:

All of the following code that follows should be pasted in to a new, empty,  VBA code module. You can download an example Excel Workbook here or just the code bas module here.


Option Explicit
Option Compare Text
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' modDLLNameOfComAddin
' By Chip Pearson, chip@cpearson.com, www.cpearson.com.
'
' This module contains the DLLOfComAddin function. 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).
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 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
Private Const MAX_PATH = As Long 260 ' Windows mandated value.

'''''''''''''''''''''''''''''
' Registry Sections
'''''''''''''''''''''''''''''
Private Const HKEY_CLASSES_ROOT As Long = &H80000000
Private Const HKEY_CURRENT_USER As Long = &H80000001
Private Const HKEY_LOCAL_MACHINE As Long = &H80000002
Private Const HKEY_USERS As Long = &H80000003

'''''''''''''''''''''''''''''
' used by FormatMessage
'''''''''''''''''''''''''''''
Private Const FORMAT_MESSAGE_ALLOCATE_BUFFER As Long = &H100
Private Const FORMAT_MESSAGE_ARGUMENT_ARRAY As Long = &H2000
Private Const FORMAT_MESSAGE_FROM_HMODULE As Long = &H800
Private Const FORMAT_MESSAGE_FROM_STRING As Long = &H400
Private Const FORMAT_MESSAGE_FROM_SYSTEM As Long = &H1000
Private Const FORMAT_MESSAGE_IGNORE_INSERTS As Long = &H200
Private Const FORMAT_MESSAGE_MAX_WIDTH_MASK As Long = &HFF
Private Const FORMAT_MESSAGE_TEXT_LEN = As Long 160 ' from ERRORS.H C++ include file.


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Windows API Declares
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

' 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

' FormatMessage gets the descriptive error messages associated with the error
' number in dwMessageId.
Private Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" ( _
    ByVal dwFlags As Long, _
    ByRef lpSource As Any, _
    ByVal dwMessageId As Long, _
    ByVal dwLanguageId As Long, _
    ByVal lpBuffer As String, _
    ByVal nSize As Long, _
    ByRef Arguments As Long) As Long


Public Function DLLOfComAddin(A_7_AB_1_ComAddIn As Office.COMAddIn) As String
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' DLLOfComAddin
' By Chip Pearson, chip@cpearson.com , www.cpearson.com
'
' This function returns the fully-qualified name of the DLL file for the
' specified COM Add-In (CAI). A_7_AB_1_ComAddIn is a reference to an existing
' CAI. It is not required that the CAI be connected.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Dim V_7_AB_1_RegistryKeyName As String ' stores the name of the registry key we're working with
Dim V_7_AB_1_RegResult As String       ' stores the name of the COM Add-In's DLL file.
Dim V_7_AB_1_Res As Long               ' general puprose return code variable
Dim V_7_AB_1_RegKey As Long            ' internal registry key value retrieved by RegOpenKey
Dim V_7_AB_1_ErrorNumber As Long       ' stores the error number than may have occurred
Dim V_7_AB_1_ErrorText As String       ' error text returned GetSystemErrorMessageText
Dim V_7_AB_1_RegResultLen As Long      ' length in characters of V_7_AB_1_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.
'''''''''''''''''''''''''''''''''''''''''''''''''
V_7_AB_1_RegResult = String$(MAX_PATH, vbNullChar)

'''''''''''''''''''''''''''''''''''''''''''''''''
' ensure we didn't get NOTHING
'''''''''''''''''''''''''''''''''''''''''''''''''
If A_7_AB_1_ComAddIn Is Nothing Then
    MsgBox "The A_7_AB_1_ComAddIn parameter is NOTHING."
    Exit Function
End If

'''''''''''''''''''''''''''''''''''''''''''''''''
' Initialzie 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.
'''''''''''''''''''''''''''''''''''''''''''''''''
V_7_AB_1_RegistryKeyName = C_COM_ADDIN_CLSID_REG_LOCATION & _
                           A_7_AB_1_ComAddIn.GUID & _
                           C_PATH_SEPARATOR & _
                           C_COM_ADDIN_CLSID_REG_VALUE_NAME

'''''''''''''''''''''''''''''''''''''''''''''''''
' Open the registry key V_7_AB_1_RegistryKeyName.
' RegOpenKey puts in V_7_AB_1_RegKey a key value
' that is used by all other registry functions
' that access that key.
'''''''''''''''''''''''''''''''''''''''''''''''''
V_7_AB_1_Res = RegOpenKey(hKey:=HKEY_LOCAL_MACHINE, _
                          lpSubKey:=V_7_AB_1_RegistryKeyName, _
                          phkResult:=V_7_AB_1_RegKey)
If V_7_AB_1_Res <> ERROR_SUCCESS Then
    V_7_AB_1_ErrorNumber = V_7_AB_1_Res
    V_7_AB_1_ErrorText = GetSystemErrorMessageText(V_7_AB_1_ErrorNumber)
    MsgBox "Error opening Registry key: '" & V_7_AB_1_RegistryKeyName & "'" & vbCrLf & _
           "System Error: " & CStr(V_7_AB_1_ErrorNumber) & _
           " Hex(&H" & Hex(V_7_AB_1_ErrorNumber) & ")" & vbCrLf & _
           "Description: " & V_7_AB_1_ErrorText
    Exit Function
End If

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

' V_7_AB_1_RegResultLen is the length in characters
' of V_7_AB_1_RegResult, the variable that will
' receive the DLL file name.
V_7_AB_1_RegResultLen = MAX_PATH
V_7_AB_1_Res = RegQueryValue(hKey:=V_7_AB_1_RegKey, _
                             lpSubKey:=vbNullString, _
                             lpValue:=V_7_AB_1_RegResult, lpcbValue:=V_7_AB_1_RegResultLen)
If V_7_AB_1_Res <> ERROR_SUCCESS Then
    V_7_AB_1_ErrorNumber = V_7_AB_1_Res
    V_7_AB_1_ErrorText = GetSystemErrorMessageText(V_7_AB_1_ErrorNumber)
    MsgBox "Error retrieving Registry key: '" & V_7_AB_1_RegistryKeyName & "'" & vbCrLf & _
            "System Error: " & CStr(V_7_AB_1_ErrorNumber) & _
            " Hex(&H" & Hex(V_7_AB_1_ErrorNumber) & ")" & vbCrLf & _
            "Description: " & V_7_AB_1_ErrorText
    RegCloseKey hKey:=V_7_AB_1_RegKey
    Exit Function
End If

'''''''''''''''''''''''''''''''''''''''''''''''''
' close our registry key
'''''''''''''''''''''''''''''''''''''''''''''''''
RegCloseKey V_7_AB_1_RegKey

'''''''''''''''''''''''''''''''''''''''''''''''''
' trim V_7_AB_1_RegResult to the vbNullChar
'''''''''''''''''''''''''''''''''''''''''''''''''
V_7_AB_1_RegResult = TrimToNull(V_7_AB_1_RegResult)

'''''''''''''''''''''''''''''''''''''''''''''''''
' return the DLL name
'''''''''''''''''''''''''''''''''''''''''''''''''
DLLOfComAddin = V_7_AB_1_RegResult

End Function

 

Private Function GetSystemErrorMessageText(ErrorNumber As Long) As String
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' GetSystemErrorMessageText
'
' This function gets the system error message text that corresponds to the error
' code returned by the GetLastError API function or the Err.LastDllError property.
' It may be used ONLY for these error codes. These are NOT the error
' numbers returned by Err.Number (for these errors, use Err.Description to get the
' description of the message). The error number MUST be the value returned by
' GetLastError or Err.LastDLLError.
'
' In general, you should use Err.LastDllError rather than GetLastError because under
' some circumstances the value of GetLastError will be reset to 0 before the value is
' returned to VB. Err.LastDllError will always reliably return the last error number
' raised in a DLL.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Dim V_7_AB_1_ErrorText As String
Dim V_7_AB_1_TextLen As Long
Dim V_7_AB_1_FormatMessageResult As Long
Dim V_7_AB_1_LangID As Long


V_7_AB_1_LangID = 0&
V_7_AB_1_ErrorText = String$(FORMAT_MESSAGE_TEXT_LEN, " ")
V_7_AB_1_TextLen = Len(V_7_AB_1_ErrorText)
V_7_AB_1_FormatMessageResult = 0&

V_7_AB_1_FormatMessageResult = FormatMessage( _
        dwFlags:=FORMAT_MESSAGE_FROM_SYSTEM Or FORMAT_MESSAGE_IGNORE_INSERTS, _
        lpSource:=0&, _
        dwMessageId:=ErrorNumber, _
        dwLanguageId:=0&, _
        lpBuffer:=V_7_AB_1_ErrorText, _
        nSize:=Len(V_7_AB_1_ErrorText), _
        Arguments:=0&)

If V_7_AB_1_FormatMessageResult > 0 Then
    ' FormatMessage returned some text. Take the left V_7_AB_1_FormatMessageResult
    ' characters and return that text.
    V_7_AB_1_ErrorText = Left$(V_7_AB_1_ErrorText, V_7_AB_1_FormatMessageResult)
    GetSystemErrorMessageText = V_7_AB_1_ErrorText
Else
    ' Format message didn't return any text.
    ' There is no text description for the specified error.
    GetSystemErrorMessageText = "NO ERROR DESCRIPTION AVAILABLE"
End If

End Function


Private Function TrimToNull(Text As String) As String
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 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.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim Pos As Integer
Pos = InStr(1, Text, vbNullChar)
If Pos > 0 Then
    TrimToNull = Left(Text, Pos - 1)
Else
    TrimToNull = Text
End If

End Function
 


Public Sub AAATestIt()
''''''''''''''''''''''''''''''''''''''''''''''
' Test procedure. This procedure may be
' deleted with no side effects.
''''''''''''''''''''''''''''''''''''''''''''''
Dim CAI As Office.COMAddIn
Dim DLLName As String

If Application.COMAddIns.Count >= 1 Then
    Set CAI = Application.COMAddIns(1)
    DLLName = DLLOfComAddin(A_7_AB_1_ComAddIn:=CAI)
    MsgBox "Addin Information:" & vbCrLf & _
           "ProgID: " & CAI.ProgID & vbCrLf & _
           "GUID: " & CAI.GUID & vbCrLf & _
           "DLL Name: " & DLLName & vbCrLf & _
           "Connected: " & CAI.Connect
Else
    MsgBox "There are no COM Add-Ins.
End If

End Sub



 

 

 

 

 
     
     

 

 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