无法使用VBA重新导入Windows产品密钥 – 自动化错误

以下代码将引发“自动化错误”

Sub GetWindowsProductKey() Set WshShell = CreateObject("WScript.Shell") MsgBox WshShell.RegRead("HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\DigitalProductId") End Sub 

但是这个代码工作正常

 Sub GetPath() Set WshShell = CreateObject("WScript.Shell") MsgBox WshShell.RegRead("HKEY_CURRENT_USER\Environment\Path") End Sub 

显然，这与被保护的产品密钥或某事有关。

我正在写一个电子表格来收集来自远程办公室的审计数据，然后再有人假设我（真的很糟糕）黑客行为。

---

UPDATE

我现在正在尝试以下方法，但我得到一个types不匹配的错误，而不是第二个function（第一个仍然有效）…

 Sub GetPathUsingStdRegProv() Const HKEY_CURRENT_USER = &H80000001 strComputer = "." Set oReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv") strKeyPath = "Environment" strValueName = "Path" oReg.GetStringValue HKEY_CURRENT_USER, strKeyPath, strValueName, strValue MsgBox strValue End Sub 

---

 Sub GetWindowsKeyUsingStdRegProv() Const HKEY_LOCAL_MACHINE = &H80000002 strComputer = "." Set oReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv") strKeyPath = "SOFTWARE\Microsoft\Windows NT\CurrentVersion" strValueName = "DigitalProductId" oReg.GetBinaryValue HKEY_LOCAL_MACHINE, strKeyPath, strValueName, strValue For i = LBound(strValue) To UBound(strValue) MsgBox strValue(i) Next End Sub 

strValue在第二个函数中为空，这就解释了types不匹配！

---

更新2

我使用这个SO问题的代码，以及

 ShellRun("wmic path softwarelicensingservice get OA3xOriginalProductKey") 

这可以在我的笔记本电脑上运行，但是不能在桌面上运行，大概是因为密钥没有存储在BIOS / UEFI中。 所以我仍然在寻找一个解决scheme！

---

更新3

我已经在下面的答案中执行了代码作为一个VBS脚本，但我在我的笔记本电脑上得到的价值是不同于我从上面的wmic技术得到？ 这是一个64位的问题？ 这一切都很混乱！