How to extract R InstallPath from Registry using Excel VBA - Stack Overflow

admin管理员组

文章数量:1435859

I am not able to extract the R path anymore from the registry. I have a 64 bit machine and Excel 2016 32 bit as well. The small R functions below used to work well with R 4.1.3 MS 365 but now that I updated to R 4.4.2 the function returns an empty path even though R exists in the registry. Could someone give me a hint? See screen shot below:

'Function to get the R installation directory path

Function GetR_HOME() As String
    'GetRegistryValue to retrieve the R "InstallPath" from the registry
    GetR_HOME = GetRegistryValue("SOFTWARE\R-core\R", "InstallPath")

End Function

'Function to get the value from the registry
Function GetRegistryValue(keyPath As String, valueName As String) As String
    Dim Reg As Object
    Dim Key As String
    Dim Value As String

    'Create WScript.Shell to interact with the registry
    Set Reg = CreateObject("WScript.Shell")

    'Try to read the registry value
    On Error Resume Next
    Value = Reg.RegRead("HKEY_LOCAL_MACHINE\" & keyPath & "\" & valueName)

    On Error GoTo 0

    'Return the result (the registry value)
    GetRegistryValue = Value                'EMPTY VALUE RETURNED'
End Function

I am not able to extract the R path anymore from the registry. I have a 64 bit machine and Excel 2016 32 bit as well. The small R functions below used to work well with R 4.1.3 MS 365 but now that I updated to R 4.4.2 the function returns an empty path even though R exists in the registry. Could someone give me a hint? See screen shot below:

'Function to get the R installation directory path

Function GetR_HOME() As String
    'GetRegistryValue to retrieve the R "InstallPath" from the registry
    GetR_HOME = GetRegistryValue("SOFTWARE\R-core\R", "InstallPath")

End Function

'Function to get the value from the registry
Function GetRegistryValue(keyPath As String, valueName As String) As String
    Dim Reg As Object
    Dim Key As String
    Dim Value As String

    'Create WScript.Shell to interact with the registry
    Set Reg = CreateObject("WScript.Shell")

    'Try to read the registry value
    On Error Resume Next
    Value = Reg.RegRead("HKEY_LOCAL_MACHINE\" & keyPath & "\" & valueName)

    On Error GoTo 0

    'Return the result (the registry value)
    GetRegistryValue = Value                'EMPTY VALUE RETURNED'
End Function

• r
• excel
• vba
• registry

Share Improve this question Follow asked Nov 15, 2024 at 20:57 SalvadorSalvador 1,71911 gold badge1717 silver badges2525 bronze badges 7

• 3 Just curious, what amazing situation is leading you to use VBA to find the R installation path? My condolences. – Jon Spring Commented Nov 15, 2024 at 22:11
• Use vba because is what Excel has as underlying programming language – Salvador Commented Nov 15, 2024 at 23:21
• 1 Everything looks fine as far as I can tell. I would comment out the line that reads On Error Resume Next and see if reading the registry is throwing an error. – BobS Commented Nov 16, 2024 at 2:37
• I did that and it raises the error registry can't be read . However, if I uninstall R-4. 4.2 and install R-4. 3.1 then the function extract the R path alright. I wonder if there is a bug in R versions greater than R-4.3.1? – Salvador Commented Nov 16, 2024 at 5:52
• 2 I can't reproduce this in 64bit environment ( W11 + M365 + R-4.4.2 ), i.e. your code works on my machine. Though when executed from 32bit (Excel, VBA), you are accessing 32bit registry keys which can be different from 64bit. You can check 32bit with 32b regedit, %systemroot%\syswow64\regedit ( learn.microsoft/en-us/troubleshoot/windows-client/… ) . – margusl Commented Nov 16, 2024 at 8:39

 |  Show 2 more comments

1 Answer 1

Sorted by: Reset to default 0

In case you have not resolved your issue, I have put together the following code which will read both 32-bit and 64-bit registry keys when running under 32-bit VBA. The code currently caters for string values and DWORD values but can be expanded to handle the other data types found in the registry. Simply create a new module and then copy and paste the code into it:

Option Explicit

#If VBA7 Then

  Private Declare PtrSafe Function RegOpenKeyEx _
                               Lib "advapi32.dll" _
                             Alias "RegOpenKeyExA" _
                                   (ByVal hKey As LongPtr, _
                                    ByVal lpSubKey As String, _
                                    ByVal ulOptions As Long, _
                                    ByVal samDesired As Long, _
                                    phkResult As LongPtr) As Long

  Private Declare PtrSafe Function RegQueryValueEx _
                               Lib "advapi32.dll" _
                             Alias "RegQueryValueExA" _
                                   (ByVal hKey As LongPtr, _
                                    ByVal lpValueName As String, _
                                    ByVal lpReserved As LongPtr, _
                                    lpType As Long, _
                                    lpData As Any, _
                                    lpcbData As Long) As Long

  Private Declare PtrSafe Function RegCloseKey _
                               Lib "advapi32.dll" _
                                   (ByVal hKey As LongPtr) As Long
#Else

  Private Declare Function RegOpenKeyEx _
                       Lib "advapi32.dll" _
                     Alias "RegOpenKeyExA" _
                           (ByVal hKey As Long, _
                            ByVal lpSubKey As String, _
                            ByVal ulOptions As Long, _
                            ByVal samDesired As Long, _
                            phkResult As Long) As Long

  Private Declare Function RegQueryValueEx _
                       Lib "advapi32.dll" _
                     Alias "RegQueryValueExA" _
                           (ByVal hKey As Long, _
                            ByVal lpValueName As String, _
                            ByVal lpReserved As Long, _
                            lpType As Long, _
                            lpData As Any, _
                            lpcbData As Long) As Long

  Private Declare Function RegCloseKey _
                       Lib "advapi32.dll" _
                           (ByVal hKey As Long) As Long
#End If

Private Const ERROR_SUCCESS = 0&, _
              HKEY_CLASSES_ROOT = &H80000000, _
              HKEY_CURRENT_USER = &H80000001, _
              HKEY_LOCAL_MACHINE = &H80000002, _
              HKEY_USERS = &H80000003, _
              HKEY_CURRENT_CONFIG = &H80000005, _
              STANDARD_RIGHTS_ALL = &H1F0000, _
              KEY_QUERY_VALUE = &H1, _
              KEY_SET_VALUE = &H2, _
              KEY_CREATE_SUB_KEY = &H4, _
              KEY_ENUMERATE_SUB_KEYS = &H8, _
              KEY_NOTIFY = &H10, _
              KEY_CREATE_LINK = &H20, _
              KEY_WOW64_64KEY = &H100, _
              KEY_WOW64_32KEY = &H200, _
              SYNCHRONIZE = &H100000, _
              ERROR_NO_MORE_ITEMS = 259&, _
              KEY_READ_32 = (&H20019 Or KEY_WOW64_32KEY) And (Not SYNCHRONIZE), _
              KEY_READ_64 = (&H20019 Or KEY_WOW64_64KEY) And (Not SYNCHRONIZE)

Private Const KEY_ALL_ACCESS_64 = ((STANDARD_RIGHTS_ALL Or _
                                    KEY_QUERY_VALUE Or _
                                    KEY_ENUMERATE_SUB_KEYS Or _
                                    KEY_NOTIFY Or _
                                    KEY_CREATE_SUB_KEY Or _
                                    KEY_SET_VALUE Or _
                                    KEY_WOW64_64KEY Or _
                                    KEY_CREATE_LINK) And _
                                    (Not SYNCHRONIZE)), _
              KEY_ALL_ACCESS_32 = ((STANDARD_RIGHTS_ALL Or _
                                    KEY_QUERY_VALUE Or _
                                    KEY_ENUMERATE_SUB_KEYS Or _
                                    KEY_NOTIFY Or _
                                    KEY_CREATE_SUB_KEY Or _
                                    KEY_SET_VALUE Or _
                                    KEY_WOW64_32KEY Or _
                                    KEY_CREATE_LINK) And _
                                    (Not SYNCHRONIZE))

Private Const REG_NONE = 0, _
              REG_SZ = 1, _
              REG_EXPAND_SZ = 2, _
              REG_BINARY = 3, _
              REG_DWORD = 4, _
              REG_DWORD_BIG_ENDIAN = 5, _
              REG_DWORD_LITTLE_ENDIAN = 4, _
              REG_LINK = 6, _
              REG_MULTI_SZ = 7, _
              REG_RESOURCE_LIST = 8, _
              REG_FULL_RESOURCE_DESCRIPTOR = 9, _
              REG_RESOURCE_REQUIREMENTS_LIST = 10, _
              REG_QWORD = 11

Public Function GetR_HOME() As String
    'GetRegistryValue to retrieve the R "InstallPath" from the registry
    GetR_HOME = GetRegistryValue(HKEY_LOCAL_MACHINE, "SOFTWARE\R-core\R", "InstallPath")
End Function

'Function to get the value from the registry
#If VBA7 Then
  Public Function GetRegistryValue(lngSection As LongPtr, _
                                   keyPath As String, _
                                   strValueName As String) As String
  Dim hKey As LongPtr
#Else
  Public Function GetRegistryValue(lngSection As Long, _
                                   keyPath As String, _
                                   strValueName As String) As String
  Dim hKey As Long
#End If

  Dim lngResult      As Long, _
      lngValueType   As Long, _
      strBuf         As String, _
      lngDataBufSize As Long, _
      lngDWORD       As Long

  If RegOpenKeyEx(lngSection, keyPath, 0&, KEY_READ_64, hKey) <> ERROR_SUCCESS Then
    If RegOpenKeyEx(lngSection, keyPath, 0&, KEY_READ_32, hKey) <> ERROR_SUCCESS Then
      MsgBox "Error opening registry key"
      Exit Function
    End If
  End If

  'retrieve information about the key
  If RegQueryValueEx(hKey, strValueName, 0&, lngValueType, ByVal 0&, lngDataBufSize) = ERROR_SUCCESS Then

    Select Case lngValueType
      Case REG_SZ
        'Create a buffer
        strBuf = String(lngDataBufSize, Chr(0))

        'retrieve the key's content
        If RegQueryValueEx(hKey, strValueName, 0&, 0&, ByVal strBuf, lngDataBufSize) = ERROR_SUCCESS Then
          'Remove trailing chr(0)'s
          GetRegistryValue = Replace(strBuf, Chr(0), vbNullString)
        End If

      Case REG_DWORD
        'retrieve the key's value
        If RegQueryValueEx(hKey, strValueName, 0&, 0&, lngDWORD, lngDataBufSize) = ERROR_SUCCESS Then
          GetRegistryValue = lngDWORD
        End If

    End Select

  End If

  RegCloseKey lngSection

End Function

本文标签： How to extract R InstallPath from Registry using Excel VBAStack Overflow