Link to home
Start Free TrialLog in
Avatar of MikeYoungMoon
MikeYoungMoon

asked on

How to get programmatically a list of all available references of a VBA project

i have found this code from microsoft answers How to get programmatically a list of all available references of a VBA project

i think this code is using APIs to retrieve information from the registry which i am completely new to.

i have excel 2016 64bit

i made it compatible with 64 and 32 bit.

this code aim is to list all of the available refereneces to return something like shown in below screenshot
User generated image
now the problem is that i still see three lines in red color which i cannot debug or find out what is cuasing that.

in screenshot below you can see which lines appear red in my machine.
User generated image
Option Explicit

#If VBA7 Then

Declare PtrSafe Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As LongPtr, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As LongPtr) As Long


Declare PtrSafe Function RegEnumKey Lib "advapi32.dll" Alias "RegEnumKeyA" (ByVal hKey As LongPtr, ByVal dwIndex As Long, ByVal lpName As String, ByVal cbName As Long) As Long


Declare PtrSafe Function RegQueryValue Lib "advapi32.dll" Alias "RegQueryValueA" (ByVal hKey As LongPtr, ByVal lpSubKey As String, ByVal lpValue As String, lpcbValue As Long) As Long

Declare PtrSafe Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As LongPtr) As Long

#Else

Private Declare Function RegOpenKeyEx _
   Lib "advapi32.dll" Alias "RegOpenKeyExA" ( _
        ByVal hKey As Long, _
        ByVal lpSubKey As String, _
        ByVal ulOptions As Long, _
        ByVal samDesired As Long, _
        ByRef phkResult As Long) As Long

Private Declare Function RegEnumKey _
   Lib "advapi32.dll" Alias "RegEnumKeyA" ( _
        ByVal hKey As Long, _
        ByVal dwIndex As Long, _
        ByVal lpName As String, _
        ByVal cbName As Long) As Long

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

Private Declare Function RegCloseKey _
   Lib "advapi32.dll" ( _
        ByVal hKey As Long) As Long
        
   #End If
Private Const HKEY_CLASSES_ROOT As Long = &H80000000
Private Const READ_CONTROL As Long = &H20000
Private Const STANDARD_RIGHTS_READ As Long = (READ_CONTROL)
Private Const KEY_QUERY_VALUE As Long = &H1
Private Const KEY_ENUMERATE_SUB_KEYS As Long = &H8
Private Const KEY_NOTIFY As Long = &H10
Private Const SYNCHRONIZE As Long = &H100000
Private Const KEY_READ As Long = (( _
                  STANDARD_RIGHTS_READ _
               Or KEY_QUERY_VALUE _
               Or KEY_ENUMERATE_SUB_KEYS _
               Or KEY_NOTIFY) _
               And (Not SYNCHRONIZE))
Private Const ERROR_SUCCESS As Long = 0&
Private Const ERROR_NO_MORE_ITEMS As Long = 259&
Private Sub RefList()
Dim R1 As Long
Dim R2 As Long
Dim hHK1 As Long
Dim hHK2 As Long
Dim hHK3 As Long
Dim hHK4 As Long
Dim i As Long
Dim i2 As Long
Dim lpPath As String
Dim lpGUID As String
Dim lpName As String
Dim lpValue As String
    Cells.Clear
    lpPath = String$(128, vbNullChar)
   lpValue = String$(128, vbNullChar)
   lpName = String$(128, vbNullChar)
   lpGUID = String$(128, vbNullChar)
    R1 = RegOpenKeyEx(HKEY_CLASSES_ROOT, "TypeLib", ByVal 0&, KEY_READ,
hHK1)
   If R1 = ERROR_SUCCESS Then
       i = 0
       Do While Not R1 = ERROR_NO_MORE_ITEMS
           R1 = RegEnumKey(hHK1, i, lpGUID, Len(lpGUID))
           If R1 = ERROR_SUCCESS Then
               R2 = RegOpenKeyEx(hHK1, lpGUID, ByVal 0&, KEY_READ, hHK2)
               If R2 = ERROR_SUCCESS Then
                   i2 = 0
                   Do While Not R2 = ERROR_NO_MORE_ITEMS
                       R2 = RegEnumKey(hHK2, i2, lpName, Len(lpName)) '1.0
                       If R2 = ERROR_SUCCESS Then
                           RegQueryValue hHK2, lpName, lpValue,
Len(lpValue)
                           RegOpenKeyEx hHK2, lpName, ByVal 0&, KEY_READ,
hHK3
                           RegOpenKeyEx hHK3, "0", ByVal 0&, KEY_READ, hHK4
                           RegQueryValue hHK4, "win32", lpPath, Len(lpPath)
                           i2 = i2 + 1
                            Cells(i + 1, 1) = lpGUID
                           Cells(i + 1, 2) = lpValue
                           Cells(i + 1, 3) = lpPath
                       End If
                   Loop
               End If
           End If
           i = i + 1
       Loop
       RegCloseKey hHK1
       RegCloseKey hHK2
       RegCloseKey hHK3
       RegCloseKey hHK4
   End If
   Columns("A:A").EntireColumn.AutoFit
   Columns("B:C").ColumnWidth = 70
   Range("A1").CurrentRegion.Sort Key1:=Range("B1")
End Sub

Open in new window

EE.xlsb
ASKER CERTIFIED SOLUTION
Avatar of Bill Prew
Bill Prew

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of MikeYoungMoon
MikeYoungMoon

ASKER

Thanks Bill. you hit the nail on the head.