Unable to read uninstall keys for x64 registry, vbscript - windows

Question

I was trying to read the Uninstall Keys (DisplayName, Display Version, Vendor ..) from both 32 and 64 Bit installation keys. I have below code but it is always giving only 32 bit keys info. As I wrote the below code it is giving the entries from 32 bit twice :(
' Constants (taken from WinReg.h)
'
Const HKEY_CLASSES_ROOT = &H80000000
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002
Const HKEY_USERS = &H80000003
Const REG_SZ = 1
Const REG_EXPAND_SZ = 2
Const REG_BINARY = 3
Const REG_DWORD = 4
Const REG_MULTI_SZ = 7
' Chose computer name, registry tree and key path
'
Set objExcel = CreateObject("Excel.Application")
objExcel.Workbooks.Add
ObjExcel.Cells (1,1) = "Application Name"
ObjExcel.Cells (1,4) = "Application Vendor"
ObjExcel.Cells (1,2) = "Application Version"
ObjExcel.Cells (1,3) = "DRM Build"
strComputer = InputBox("Enter the Machine name. To run on the current machine, press ENTER", "Machine Name", "")
If strComputer = "" Then
strComputer = "."
End If
Msgbox "Script is Running and may take couple of minutes to complete. Click on OK to continue",0, "Information"
hDefKey = HKEY_LOCAL_MACHINE
' Connect to registry provider on target machine with current user
Set oReg = GetObject("winmgmts:\\" & strComputer & "\root\default:StdRegProv")
'{impersonationLevel=impersonate}!
' Enum the subkeys of the key path we've chosen
strKeyPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall"
row = 2
getRegistryEntries hDefKey, strKeyPath, ObjExcel, oReg, row
strKeyPath = "SOFTWARE\Wow6432Node\Microsoft\Windows\CurrentVersion\Uninstall"
getRegistryEntries hDefKey, strKeyPath, ObjExcel, oReg, row
fileName = Year(now) & month(now) & day(now) & hour(now) & minute(now) & second(now)
ObjExcel.ActiveWorkbook.SaveAs "C:\" & fileName & ".xlsx"
ObjExcel.Quit
Set ObjExcel = Nothing
msgbox "Work Done, file saved in C Drive with the name: " & fileName
Function getRegistryEntries(hDefKey, strKeyPath, byRef objExcel, byRef oReg, byRef row)
oReg.EnumKey hDefKey, strKeyPath, arrSubKeys
Set objShell = CreateObject("WScript.Shell")
For Each strSubkey In arrSubKeys
' Show the subkey
'
furtherKeys = False
strDisName = "HKEY_LOCAL_MACHINE\" & strKeyPath & "\" & strSubkey & "\DisplayName"
On Error Resume Next
present = False
disName = objShell.RegRead(strDisName)
If disName <> "" Then
present = True
End If
disVersionPresent = false
disVer = ""
If present = true Then
strDisVer = "HKEY_LOCAL_MACHINE\" & strKeyPath & "\" & strSubkey & "\DisplayVersion"
strDisVendor = "HKEY_LOCAL_MACHINE\" & strKeyPath & "\" & strSubkey & "\Publisher"
strDRMBuild = "HKEY_LOCAL_MACHINE\" & strKeyPath & "\" & strSubkey & "\DRMBUILD"
disVer = objShell.RegRead(strDisVer)
If err.number = 0 Then
disVersionPresent = True
End If
If disVersionPresent Then
ObjExcel.Cells (row,1) = disName
ObjExcel.Cells (row,2) = "'" & disVer
furtherKeys = True
disVendor = objShell.RegRead(strDisVendor)
If err.number = 0 Then
ObjExcel.Cells (row,4) = disVendor
End If
DRMBuild = objShell.RegRead(strDRMBuild)
If err.number = 0 Then
ObjExcel.Cells (row,3) = "'" & DRMBuild
End If
End If
End If
If furtherKeys Then
row = row + 1
End If
Next
End Function