今回もVBScriptネタです。
今回は「プログラムと機能」から、インストールされているアプリケーションの一覧を取得するスクリプトを書いてみました。

Option Explicit

Dim itm

With CreateObject("Shell.Application").Namespace("shell:::{7b81be6a-ce2b-4676-a29e-eb907a5126c5}")
  For Each itm In .Items
    WScript.Echo itm.Name
  Next
End With

仕組みは「AppUserModelId(AUMID)を列挙するVBScript」と同じで、「プログラムと機能」をフォルダとして扱い、中にあるアイテム(FolderItem2)の名前を列挙しているだけです。

このスクリプトを利用すると、指定したアプリケーションがインストールされているかどうかを判別するスクリプトも簡単に書くことができます。
(名前だけで判断しているので、正確性に欠ける場合があるかもしれませんが)

Option Explicit

MsgBox IsInstalledApplication("ABCDEFG") 'インストールされていない場合は空の文字列が返る
MsgBox IsInstalledApplication("7-Zip") 'インストールされている場合はプログラム名が返る

Private Function IsInstalledApplication(ByVal AppName)
'指定したアプリケーションがインストールされているか判別
  Dim ret
  Dim itm
  
  ret = "" '初期化
  With CreateObject("Shell.Application").Namespace("shell:::{7b81be6a-ce2b-4676-a29e-eb907a5126c5}")
    For Each itm In .Items
      If InStr(LCase(itm.Name), LCase(AppName)) Then
        ret = itm.Name
        Exit For
      End If
    Next
  End With
  IsInstalledApplication = ret
End Function

レジストリにあるアンインストール情報から取得することもできます。

Option Explicit

MsgBox IsInstalledApplication("ABCDEFG") 'インストールされていない場合は空の文字列が返る
MsgBox IsInstalledApplication("7-Zip") 'インストールされている場合はプログラム名が返る

Private Function IsInstalledApplication(ByVal AppName)
'指定したアプリケーションがインストールされているか判別
  Dim reg
  Dim keys
  Dim key
  Dim ret
  Dim res
  Dim display_name
  Const HKEY_CURRENT_USER = &H80000001
  Const HKEY_LOCAL_MACHINE = &H80000002
  Const SubKeyName = "Software\Microsoft\Windows\CurrentVersion\Uninstall\"
  Const SubKeyNameX86 = "Software\Wow6432Node\Microsoft\Windows\CurrentVersion\Uninstall\"
  
  res = "" '初期化
  Set reg = CreateObject("WbemScripting.SWbemLocator") _
            .ConnectServer(, "root\default").Get("StdRegProv")
  
  On Error Resume Next
  reg.EnumKey HKEY_LOCAL_MACHINE, SubKeyName, keys
  For Each key In keys
    display_name = ""
    ret = reg.GetStringValue(HKEY_LOCAL_MACHINE, SubKeyName & key, "DisplayName", display_name)
    If ret <> 0 Then ret = reg.GetStringValue(HKEY_LOCAL_MACHINE, SubKeyName & key, "QuietDisplayName", display_name)
    If (ret = 0) And (Len(Trim(display_name)) > 0) Then
      If InStr(LCase(display_name), LCase(AppName)) Then
        res = display_name
        Exit For
      End If
    End If
  Next
  On Error GoTo 0
  
  '64ビットアプリケーションに無い場合は32ビットアプリケーションを検索
  If (Isx64() = True) And (Len(Trim(res)) < 1) Then
    On Error Resume Next
    reg.EnumKey HKEY_LOCAL_MACHINE, SubKeyNameX86, keys
    For Each key In keys
      display_name = ""
      ret = reg.GetStringValue(HKEY_LOCAL_MACHINE, SubKeyNameX86 & key, "DisplayName", display_name)
      If ret <> 0 Then ret = reg.GetStringValue(HKEY_LOCAL_MACHINE, SubKeyNameX86 & key, "QuietDisplayName", display_name)
      If (ret = 0) And (Len(Trim(display_name)) > 0) Then
        If InStr(LCase(display_name), LCase(AppName)) Then
          res = display_name
          Exit For
        End If
      End If
    Next
    On Error GoTo 0
  End If
  
  'HKLMに無い場合はHKCUを検索
  If Len(Trim(res)) < 1 Then
    On Error Resume Next
    reg.EnumKey HKEY_CURRENT_USER, SubKeyName, keys
    For Each key In keys
      display_name = ""
      ret = reg.GetStringValue(HKEY_CURRENT_USER, SubKeyName & key, "DisplayName", display_name)
      If ret <> 0 Then ret = reg.GetStringValue(HKEY_CURRENT_USER, SubKeyName & key, "QuietDisplayName", display_name)
      If (ret = 0) And (Len(Trim(display_name)) > 0) Then
        If InStr(LCase(display_name), LCase(AppName)) Then
          res = display_name
          Exit For
        End If
      End If
    Next
    On Error GoTo 0
  End If
  
  IsInstalledApplication = res
End Function

Private Function Isx64()
'64ビット環境かどうかを判別
  Dim colItems
  Dim itm
  Dim ret
   
  ret = False '初期化
  Set colItems = CreateObject("WbemScripting.SWbemLocator").ConnectServer.ExecQuery("Select * From Win32_OperatingSystem")
  For Each itm In colItems
    If InStr(itm.OSArchitecture, "64") Then
      ret = True
      Exit For
    End If
  Next
  Isx64 = ret
End Function

ただし、こちらの方法で取得できるのはUninstallキー以下に情報があるアプリケーションのみになります。