使用Excel VBA查找注册表项

Question

我想检查用户是否安装了Microsoft SQL Native Client 2008（sqlncli10）或Native Client 2012（sqlncli11）。

Dim key As String
Dim myShell As Object
Set myShell = CreateObject("WScript.Shell")

key = "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Microsoft SQL Server\SQLNCLI11\CurrentVersion\Version"
'key = "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\CurrentVersion"

Dim strKey As String
strKey = myShell.RegReadkey(key)

在查找本机客户端时，我收到错误：

注册表项“HKEY_LOCAL_MACHINE \ SOFTWARE \ Microsoft SQL Server \ SQLNCLI11 \ CurrentVersion \ Version”中的根目录无效

但是在尝试Windows NT版本时它工作正常。

我用HKLM替换了HKEY_LOCAL_MACHINE：但这也不起作用。

编辑

我想，我只是想通了。当我在注册表中签入时，它存在于64位部分中。但是，VBA检查为32位，而SOFTWARE的根目录为Wow6432Node。所以它检查Wow6432Node \ Microsoft \ Microsoft SQL Server并且那里不存在密钥。但我找到了另一个路径SOFTWARE \ Microsoft \ Microsoft SQL Server Native Client 10或11，它们同时存在于32位和64位中。

Answer 1

这段代码适合我：

Dim key As String
Dim objShell As Object

Set objShell = CreateObject("WScript.Shell")
key = objShell.RegRead _
    ("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Microsoft SQL Server\SQLNCLI11\CurrentVersion\Version")

我刚刚在Excel 2010 VBA编辑器中执行了此操作。

Answer 2

而不是WScript使用下面的功能。这适用于32位和64位。

Function ReadRegistry(RootKey, Key As String, Value As String, Optional RegType As Integer = 32) As String


    ' Reads a REG_SZ value from the local computer's registry using WMI.
    ' Parameters:
    '   RootKey - The registry hive (see http://msdn.microsoft.com/en-us/library/aa390788(VS.85).aspx for a list of possible values).
    '   Key - The key that contains the desired value.
    '   Value - The value that you want to get.
    '   RegType - The registry bitness: 32 or 64.


    Dim oCtx, oLocator, oReg, oInParams, oOutParams

    Set oCtx = CreateObject("WbemScripting.SWbemNamedValueSet")
    oCtx.Add "__ProviderArchitecture", RegType

    Set oLocator = CreateObject("Wbemscripting.SWbemLocator")
    Set oReg = oLocator.ConnectServer("", "root\default", "", "", , , , oCtx).Get("StdRegProv")

    Set oInParams = oReg.Methods_("GetStringValue").InParameters
    oInParams.hDefKey = RootKey
    oInParams.sSubKeyName = Key
    oInParams.sValueName = Value

    Set oOutParams = oReg.ExecMethod_("GetStringValue", oInParams, , oCtx)

    ReadRegistry = oOutParams.sValue
End Function

Sub test()
  Const HKEY_CURRENT_USER = &H80000001
  MsgBox ReadRegistry(HKEY_CURRENT_USER, "Software\Microsoft\Office\15.0\Outlook\Security", "OutlookSecureTempFolder")
End Sub