Find All Products

[SeanK]

I got code from this forum that will list out all of the installed Microsoft Office Apps, but I'd like to be able to list EVERY installed application on my machine.

Any ideas how I would do that?

[Hack]

'Written by Tygur
'Original link: [url]http://www.vbforums.com/showthread.php?s=&threadid=152777[/url]
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
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, phkResult As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegEnumKeyEx Lib "advapi32.dll" Alias "RegEnumKeyExA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, lpcbName As Long, ByVal lpReserved As Long, ByVal lpClass As String, lpcbClass As Long, lpftLastWriteTime As FILETIME) As Long
 
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Const KEY_QUERY_VALUE = &H1
Private Const KEY_ENUMERATE_SUB_KEYS = &H8
Private Const ERROR_NO_MORE_ITEMS = 259&
Private Const REG_SZ = 1
Private Type FILETIME
        dwLowDateTime As Long
        dwHighDateTime As Long
End Type
 
Private RetArray() As String
 
 
Private Function GetInstalledApps() As String()
 
Dim hParentKey As Long
Dim hSubKey As Long
Dim lIndex As Long
Dim sAppID As String
Dim lAppID As Long
Dim sAppName As String
Dim lAppName As Long
Dim ValueType As Long
Dim DummyTime As FILETIME
Dim UbRetArray As Long
Dim sErr As String
Dim lErr As Long
 
UbRetArray = -1
If RegOpenKeyEx(HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Uninstall", 0, KEY_ENUMERATE_SUB_KEYS, hParentKey) = 0 Then
    sAppID = Space(64)
    lAppID = 64
    Do While RegEnumKeyEx(hParentKey, lIndex, sAppID, lAppID, 0, vbNullString, 0, DummyTime) = 0
        sAppID = Left(sAppID, lAppID)
        If RegOpenKeyEx(hParentKey, sAppID, 0, KEY_QUERY_VALUE, hSubKey) = 0 Then
            lAppName = 0
            If RegQueryValueEx(hSubKey, "DisplayName", 0, ValueType, ByVal 0, lAppName) = 0 Then
                If ValueType = REG_SZ Then
                    sAppName = Space(lAppName)
                    RegQueryValueEx hSubKey, "DisplayName", 0, 0, ByVal sAppName, lAppName
                    sAppName = Left(sAppName, lAppName - 1)
                    UbRetArray = UbRetArray + 1
                    ReDim Preserve RetArray(UbRetArray)
                    RetArray(UbRetArray) = sAppName
                End If
            End If
            RegCloseKey hSubKey
            hSubKey = 0
        End If
        lIndex = lIndex + 1
        sAppID = Space(64)
        lAppID = 64
    Loop
    RegCloseKey hParentKey
End If
GetInstalledApps = RetArray
End Function
 
Private Sub Command1_Click()
GetInstalledApps
Dim i As Long
For i = LBound(RetArray) To UBound(RetArray)
    List1.AddItem RetArray(i)
Next
End Sub

[phinds]

For major applications that register with windows, there's probably an API call that would help you out, but remember, many small apps don't register or show up on window's radar at all so I don't think there's likely anything you can do to ferret them out other than do a search for all EXE files and that's not going to give you exactly the list you're looking for

[SeanK]

For major applications that register with windows, there's probably an API call that would help you out, but remember, many small apps don't register or show up on window's radar at all so I don't think there's likely anything you can do to ferret them out other than do a search for all EXE files and that's not going to give you exactly the list you're looking for

True, but the code Hack posted should do just fine.