Windowsインストーラー（MSI）でインストールされたソフトウェアの情報を取得する。

'************************************************************************
'　MSI でインストールされたソフトウェアの一覧を取得
'************************************************************************
Sub getMSIProduct()

    '出力用シートの追加
    Dim sShtNm As String: sShtNm = "InstallList"
    Call addSheet(sShtNm)

    'SWbemLocatorオブジェクトを作成してWMIに接続
    Dim oWMI As Object
    Set oWMI = CreateObject("WbemScripting.SWbemLocator").ConnectServer
    
    'オブジェクト取得のクエリを実行
    Dim oQrySet As Object
    Set oQrySet = oWMI.ExecQuery("SELECT * FROM Win32_Product")
    
    'インストールされたソフトウェアの一覧を作成
    With Sheets(sShtNm)
        .Cells(1, 1) = "プロダクト名"
        .Cells(1, 2) = "バージョン"
        .Cells(1, 3) = "ベンダー"
        .Cells(1, 4) = "インストール日"
        .Cells(1, 5) = "識別番号"
        .Cells(1, 6) = "インストールパッケージ名"
        .Cells(1, 7) = "インストールパッケージの識別子"
    
        Dim oPRDCT As Object
        Dim i As Long
        i = 2
        For Each oPRDCT In oQrySet
            .Cells(i, 1) = oPRDCT.Name
            .Cells(i, 2) = oPRDCT.Version
            .Cells(i, 3) = oPRDCT.Vendor
            .Cells(i, 4) = oPRDCT.InstallDate
            .Cells(i, 5) = oPRDCT.IdentifyingNumber
            .Cells(i, 6) = oPRDCT.PackageName
            .Cells(i, 7) = oPRDCT.PackageCode
            i = i + 1
        Next
        End With
    
    Set oQrySet = Nothing
    
End Sub

'******************************************************************
'　シートの追加
'------------------------------------------------------------------
'　　第１引数：設定したいシート名
'******************************************************************
Sub addSheet(getShtNm As String)
    
    '右端にシートを追加する
    Worksheets.Add After:=Sheets(Sheets.Count)
    
    'シートの名前を設定
    On Error Resume Next
    Do While True
        ActiveSheet.Name = getShtNm
        If Err.Number = 0 Then
            Exit Do
        Else
            'シート名が重複する場合は末尾に日時を付けて対応
            getShtNm = getShtNm & "_" & Format(Now(), "yyyymmddhhmmss")
            Err.Clear
        End If
    Loop
    On Error GoTo 0

End Sub

　■実行結果