如何列出所有已安装的应用程序到excel

Question

我使用下面的代码列出了安装在Excel工作表中的所有软件

Sub ListAllSoftware()
    Application.Run (Clear)
    Dim StrComputer As String
    Dim objWMIService As Object
    Dim objSoftware As Object
    Dim objAllSoftwares As Object
    Dim i As Integer

    Application.ScreenUpdating = False

    Worksheets("sheet1").Activate

    StrComputer = "."
    Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & StrComputer & "\root\cimv2")
    Set objAllSoftwares = objWMIService.ExecQuery("Select * from Win32_Product")

    'Start right below sheet headers.
    i = 2

    If objAllSoftwares.Count > 0 Then


        For Each objSoftware In objAllSoftwares
            With objSoftware
                Worksheets("sheet1").Cells(i, 1).Value = .Caption
                Worksheets("sheet1").Cells(i, 2).Value = .Version
            End With
            'Go to the next row.
            i = i + 1
        Next

        With Worksheets("sheet1")
            .Range("A:D").Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlYes
            .Columns("A:D").EntireColumn.AutoFit
            .Range("A2").Select
        End With

        Application.ScreenUpdating = True

        MsgBox "All applications from this computer were retrieved successfully!", vbInformation, "Done"

    Else

        Application.ScreenUpdating = True

        MsgBox "Unfortunatelly, applications from this computer could not be retrieved!", vbCritical, "Error"

    End If
End Sub


Sub Clear()
    Dim LastRow As Integer

    With Worksheets("sheet1")
        .Activate
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        If LastRow > 1 Then
            .Range("A2:e" & LastRow).Clear
        End If
        .Columns("A:e").EntireColumn.AutoFit
        .Range("A2").Select
    End With
End Sub

问题是它只返回一些已安装的应用程序，而不是所有应用程序。我如何获得一切？例如，我安装了GPL Ghostscript，它没有出现在此代码生成的列表中。我可以在添加删除（Windows 7中的程序和功能）控制面板中看到GPL Ghostscript。是否可以将控制面板中的列表输入excel？