Win 7, Office 14, VBA call to WEBM call to StdRegPro (no access) but same code work in VBS Script.

[Dan Ross]

Anyone have any clues ??

I'm using the exact same code in a VBA app and a VBS file (cscript engine)
Works in VBS but fails in VBA?

Well - it doesn't actually FAIL with an error but I get no data from the
VBA execution. No Error is being generated. I added a call .CheckAccess
on the regkey for "READ" permissions.

This is not specific to the particular key, It also occurs with other
regkeys - I'm not sure what the common denominator is or why this insn't
working in one but seems fine with the other. I seem to have access in VBA
on this node only at the "SOFTWARE\MICROSOFT" levle. RESULTS: In excel vba
access to the key is "FALSE" in cscript access to the KEY is TRUE -- ??
(seems odd) - Yes, I've check Excell Trust Center and enabled all the "not
recommended features"

RESULTS:
TestVBA
Applicatin: Microsoft Excel
HasAccess To: CO1MSFTEPPIIS01\SOFTWARE\Microsoft\Virtual
Machine\Guest\Parameters\PhysicalHostName Returned: False
SubKey 'CO1MSFTEPPIIS01\SOFTWARE\Microsoft\Virtual
Machine\Guest\Parameters\PhysicalHostName' Returned: NULL


C:\Temp>VMHost.vbs
Microsoft (R) Windows Script Host Version 5.8
Copyright (C) Microsoft Corporation. All rights reserved.

Windows Script Host
HasAccess To: CO1MSFTEPPIIS02\SOFTWARE\Microsoft\Virtual
Machine\Guest\Parameters\PhysicalHostName Returned: True
SubKey 'CO1MSFTEPPIIS02\SOFTWARE\Microsoft\Virtual
Machine\Guest\Parameters\PhysicalHostName' Returned: CO1-CU-SV-00110

I also created a VB Console App and that seems to work fine (same code)


' <-- scrip block bellow -->
Call TestVBS

Sub TestVBS()
'objwbemServices = .ConnectServer(
' [ strServer = "." ],
' [ strNamespace = "" ],
' [ strUser = "" ],
' [ strPassword = "" ],
' [ strLocale = "" ],
' [ strAuthority = "" ],
' [ iSecurityFlags = 0 ],
' [ objwbemNamedValueSet = 0 ]
')
Const HKEY_LOCAL_MACHINE = &H80000002
Const KEY_VM_HOST_SUBKEY = "SOFTWARE\Microsoft\Virtual
Machine\Guest\Parameters"
Const KEY_VM_HOST_VALUE = "PhysicalHostName"
Const KEY_QUERY_VALUE = &H1

Dim oLoc 'As WbemScripting.SWbemLocator
Dim oSvc 'As WbemScripting.SWbemServices
Dim oReg 'As WbemScripting.SWbemObject
Dim sServer 'As String


If IsObject(Wscript) Then
Wscript.echo Wscript.Name
Else
Debug.Print Application.Name
End If

sServer = "CO1MSFTEPPIIS02"

Set oLoc = CreateObject("WbemScripting.SWbemLocator")
Set oSvc = oLoc.ConnectServer(sServer, "\root\default") ' Have also tried
\root\cimv2 namespace.
Set oReg = oSvc.Get("StdRegProv")

'CHECK KEY ACCESS
oReg.CheckAccess HKEY_LOCAL_MACHINE, KEY_VM_HOST_SUBKEY,
KEY_QUERY_VALUE, TheValue
If Err.Number <> 0 Then
Set WmiError = CreateObject("WbemScripting.SWbemLastError")
For Each oP In WmiError.Properties_
If IsObject(Wscript) Then
Wscript.echo oP.Name, oP.Value
Else
Debug.Print oP.Name, oP.Value
End If
Next
If IsObject(Wscript) Then
Wscript.echo WmiError.operation, WmiError(0)
Else
Debug.Print WmiError.operation, WmiError(0)
End If
End If
If IsObject(Wscript) Then
Wscript.echo "HasAccess To: " & sServer & "\" & KEY_VM_HOST_SUBKEY &
"\" & KEY_VM_HOST_VALUE & " Returned: " & TheValue
Else
Debug.Print "HasAccess To: " & sServer & "\" & KEY_VM_HOST_SUBKEY &
"\" & KEY_VM_HOST_VALUE & " Returned: " & TheValue
End If



oReg.GetStringValue HKEY_LOCAL_MACHINE, KEY_VM_HOST_SUBKEY,
KEY_VM_HOST_VALUE, TheValue
If Err.Number <> 0 Then
Set WmiError = CreateObject("WbemScripting.SWbemLastError")
For Each oP In WmiError.Properties_
If IsObject(Wscript) Then
Wscript.echo oP.Name, oP.Value
Else
Debug.Print oP.Name, oP.Value
End If
Next
If IsObject(Wscript) Then
Wscript.echo WmiError.operation, WmiError(0)
Else
Debug.Print WmiError.operation, WmiError(0)
End If
End If
If IsNull(TheValue) Then
TheValue = "NULL"
End If
If IsObject(Wscript) Then
Wscript.echo "SubKey '" & sServer & "\" & KEY_VM_HOST_SUBKEY & "\" &
KEY_VM_HOST_VALUE & "' Returned: " & TheValue
Else
Debug.Print "SubKey '" & sServer & "\" & KEY_VM_HOST_SUBKEY & "\" &
KEY_VM_HOST_VALUE & "' Returned: " & TheValue
End If
End Sub