title: Get installed programs list both 32 and 64 bit programs
body: <p>Below is my complete code which gets list of programs installed on a PC. But when the application is run in 64 bit pc the "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\" registry will automatically refer to "SOFTWARE\Wow6432Node\Microsoft\Windows\CurrentVersion\Uninstall" due to registry redirection. But i want to get all programs installed on a PC. so i think i have to access both 64 bit and 32 bit hive. So how can i access 64 bit hive and 32 bit to all installed programs OR is there any other tricks to get same? Below is my existing code.</p>
  
  <pre><code>Option Explicit
  
  
  Dim StrComputer As String
  Dim sCompName As String
  
  Dim sFileName As String
  
  Function GetAddRemove(sComp)
    'Function credit to Torgeir Bakken
    Dim cnt, oReg, sBaseKey, iRC, aSubKeys
    Const HKLM = &amp;H80000002 'HKEY_LOCAL_MACHINE
    Set oReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" &amp; _
                sComp &amp; "/root/default:StdRegProv")
    sBaseKey = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\"
    iRC = oReg.EnumKey(HKLM, sBaseKey, aSubKeys)
  
    Dim sKey, sValue, sTmp, sVersion, sDateValue, sYr, sMth, sDay
  
    For Each sKey In aSubKeys
      iRC = oReg.GetStringValue(HKLM, sBaseKey &amp; sKey, "DisplayName", sValue)
      If iRC &lt;&gt; 0 Then
        oReg.GetStringValue HKLM, sBaseKey &amp; sKey, "QuietDisplayName", sValue
      End If
      If sValue &lt;&gt; "" Then
        iRC = oReg.GetStringValue(HKLM, sBaseKey &amp; sKey, _
                                  "DisplayVersion", sVersion)
        If sVersion &lt;&gt; "" Then
          sValue = sValue &amp; ",Ver: " &amp; sVersion
        Else
          sValue = sValue
        End If
        sTmp = sTmp &amp; sValue &amp; vbCrLf
      cnt = cnt + 1
      End If
    Next
    sTmp = BubbleSort(sTmp)
    GetAddRemove = "INSTALLED SOFTWARE (" &amp; cnt &amp; ") - " &amp; sCompName &amp; _
                   " - " &amp; Now() &amp; vbCrLf &amp; vbCrLf &amp; sTmp
  End Function
  
  Function BubbleSort(sTmp)
    'cheapo bubble sort
    Dim aTmp, i, j, temp
    aTmp = Split(sTmp, vbCrLf)
    For i = UBound(aTmp) - 1 To 0 Step -1
      For j = 0 To i - 1
        If LCase(aTmp(j)) &gt; LCase(aTmp(j + 1)) Then
          temp = aTmp(j + 1)
          aTmp(j + 1) = aTmp(j)
          aTmp(j) = temp
        End If
      Next
    Next
    BubbleSort = Join(aTmp, vbCrLf)
  End Function
  
  Function WriteFile(sData, sFileName)
   Dim intFile As Integer
    Dim strFile As String
    strFile = sFileName
    intFile = FreeFile
    Open strFile For Output As #intFile
      Print #intFile, sData
    Close #intFile
  End Function
  
  Private Sub Form_Load()
  StrComputer = "."
  sFileName = "D:\desktop\ins.txt"
  Dim s As String
  s = GetAddRemove(".")
  Call WriteFile(s, sFileName)
  End Sub
  </code></pre>