Read and write from/to registry in VBA

Question

I saw this line in C# and I am trying to adapt it to VBA:

Microsoft.Win32.Registry.SetValue(@"HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Services\USBSTOR", "Start", 4,Microsoft.Win32.RegistryValueKind.DWord);

I'm quite lost here with some error:

Runtime: 5 - invalid procedure call)

When I use the default i_Type string "REG_SZ" instead of "Start", then I get a regkey related error:

Runtime - -2147024891[80070005] invalid root

My code:

Dim i_RegKey As String, i_Value As String, i_Type As String
Dim myWS As Object
i_Type = "REG_SZ"  ' Optional
'access Windows scripting
Set myWS = CreateObject("WScript.Shell")
'write registry key
i_RegKey = "HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Services\USBSTOR\Start"
i_Value = "4"
i_Type = "REG_DWORD"
myWS.RegWrite i_RegKey, i_Value, i_Type

Solution 1

I think the problem here was that the macro did not have permission to write to the registry.

More information in this page. I could read the key's value using the WScript object just fine:

Debug.Print CreateObject("WScript.Shell").RegRead("HKLM\SYSTEM\CurrentControlSet\Services\USBSTOR\Start")

To write (it should work if you have permissions):

CreateObject("WScript.Shell").RegWrite "HKLM\SYSTEM\CurrentControlSet\Services\USBSTOR\Start", 4, "REG_DWORD"

How I got it to work (since my script does not seem to have the necessary permissions):

ShellExecute 0, "runas", "C:\Windows\System32\cmd.exe", "/k %windir%\System32\reg.exe ADD HKLM\SYSTEM\CurrentControlSet\Services\USBSTOR /f /v Start /t REG_DWORD /d 4", "C:\", 0

In this last example the user will be prompted to provide the necessary permission.

PS: HKLM is an abreviation for HKEY_LOCAL_MACHINE. All other root key names have similar abreviations that can be consulted in the page mentioned at the top.

As a practical example I will post my usage of these expressions to enable/disable USB mass storage (when on disable, when off enable):

Sub DoUSB_Control()
    If CreateObject("WScript.Shell").RegRead("HKLM\SYSTEM\CurrentControlSet\Services\USBSTOR\Start") = 3 Then
        ShellExecute 0, "runas", "C:\Windows\System32\cmd.exe", "/k %windir%\System32\reg.exe ADD HKLM\SYSTEM\CurrentControlSet\Services\USBSTOR /f /v Start /t REG_DWORD /d 4", "C:\", 0
    Else
        ShellExecute 0, "runas", "C:\Windows\System32\cmd.exe", "/k %windir%\System32\reg.exe ADD HKLM\SYSTEM\CurrentControlSet\Services\USBSTOR /f /v Start /t REG_DWORD /d 3", "C:\", 0
    End If
End Sub

Solution 2

Update:

While the below code was good for learning, there is a VBA Built in Function for working w/ Registry, but I suppose it's only useful for storing/saving settings in Registry related to your VBA project, not setting/retrieving settings from "other programs"/"locations in Registry".

See GetSetting and SaveSetting and DeleteSetting

https://docs.microsoft.com/en-us/office/vba/language/reference/user-interface-help/getsetting-function

https://docs.microsoft.com/en-us/office/vba/language/reference/user-interface-help/deletesetting-statement

https://docs.microsoft.com/en-us/office/vba/language/reference/user-interface-help/savesetting-statement

I built a function to accept/utilize all three as shown below, but it's not needed. I opened up RegEdit and used F5 to Refresh and watch as I stepped through code.

Option Explicit
Public Sub Test_RegKeyFunc()

 Dim appname As String, section As String, key As String, default, KeyVal, GetSettingBool As Boolean, SaveSettingBool As Boolean, DelSettingBool As Boolean
 appname = "MyApp"
 section = "MySettings"
 key = "AutoDoThisBool"
 KeyVal = "TRUE"
 Call RegKeyFunc(appname, section, key, , KeyVal) ' Call Func without setting Save = True Returns ""
 Debug.Print RegKeyFunc(appname, section, key, , KeyVal)
 If RegKeyFunc(appname, section, key, , KeyVal) = "" Then
  Stop
 End If
 Call RegKeyFunc(appname, section, key, , KeyVal, , True) ' Call Func and Save Setting
 Debug.Print RegKeyFunc(appname, section, key, , KeyVal)
 If RegKeyFunc(appname, section, key, , KeyVal) = "TRUE" Then
  Stop
 End If
 Call RegKeyFunc(appname, section, key, , KeyVal, , , True) ' Call Func and Del Key/Setting
 Debug.Print RegKeyFunc(appname, section, key, , KeyVal)
 If RegKeyFunc(appname, section, key, , KeyVal) = "" Then
  Stop
 End If
 Stop
 Call RegKeyFunc(appname, section, key, , KeyVal, , , , True) ' Call Func and Del SubFolder/Section
 Debug.Print RegKeyFunc(appname, section, key, , KeyVal)
 If RegKeyFunc(appname, section, key, , KeyVal) = "" Then
  Stop
 End If
 Stop
 Call RegKeyFunc(appname, section, key, , KeyVal, , , , , True) ' Call Func and Del Folder
 Debug.Print RegKeyFunc(appname, section, key, , KeyVal)
 If RegKeyFunc(appname, section, key, , KeyVal) = "" Then
  Stop
 End If
 Stop
End Sub
Public Function RegKeyFunc(appname As String, section As String, Optional key As String, Optional default, Optional KeyVal, Optional GetSettingBool As Boolean, Optional SaveSettingBool As Boolean, Optional DelSettingBool As Boolean, Optional DelSectionBool As Boolean, Optional DelAppBool As Boolean)
 'HKCU\SOFTWARE\VB and VBA Program Settings
 If SaveSettingBool = True Then
  SaveSetting appname, section, key, KeyVal
 End If
 If DelSettingBool = True Then
  DeleteSetting appname, section, key
 End If
 If DelSectionBool = True Then
  DeleteSetting appname, section
 End If
 If DelAppBool = True Then
  DeleteSetting appname
 End If '
 RegKeyFunc = GetSetting(appname, section, key, default)
End Function

End Update

---

Heres my generic VBA code for working w/ Windows Registry.

Public Function ReadRegKeyVal(RegKeyStr As String) As Integer
 ReadRegKeyVal = CreateObject("WScript.Shell").RegRead(RegKeyStr)
End Function

---

Public Function RegKeyExists(RegKeyStr As String) As Boolean

  On Error GoTo ErrorHandler
  CreateObject("WScript.Shell").RegRead (RegKeyStr)
  RegKeyExists = True
  Exit Function
  
ErrorHandler:
  RegKeyExists = False
End Function

---

Public Sub SaveRegKey(RegKeyStr As String, RegKeyDesiredStateInt As Integer, Optional RegKeyType As String = "REG_DWORD")
 CreateObject("WScript.Shell").RegWrite RegKeyStr, RegKeyDesiredStateInt, RegKeyType
 Debug.Print "Generated --> " & RegKeyStr & "," & RegKeyDesiredStateInt & "," & RegKeyType
End Sub

An Example Call Sub:

Public Const DWordRegKeyEnabled As Integer = 1
Public Const DWordRegKeyDisabled As Integer = 0

Public RegKeyStr As String, RegKeyLocStr As String, RegKeyNameStr As String
Public RegKeyDesiredStateInt As Integer, RegKeyCurrentStateInt As Integer
Public RegKeyFoundBool As Boolean

---

Public Sub SetMinMaxEnabledInExcelStatusBar()

 RegKeyDesiredStateInt = DWordRegKeyEnabled
 
 RegKeyLocStr = "HKEY_CURRENT_USER\SOFTWARE\Microsoft\Office\" & Application.Version & "\Excel\StatusBar\"
 RegKeyNameStr = "MaxValue"
 RegKeyStr = RegKeyLocStr & RegKeyNameStr
 Debug.Print "RegKeyStr = " & RegKeyStr
 Call SetRegKey(RegKeyStr, RegKeyDesiredStateInt)

End Sub

---

Public Sub SetRegKey(RegKeyStr As String, RegKeyDesiredStateInt As Integer)
 
 RegKeyFoundBool = RegKeyExists(RegKeyStr)
 Debug.Print "RegKeyFoundBool = " & RegKeyFoundBool
 
 If RegKeyFoundBool = False Then
  Debug.Print "RegKeyFoundBool = False"
  Call SaveRegKey(RegKeyStr, RegKeyDesiredStateInt)
 Else
  Debug.Print "RegKeyFoundBool = True"
  
  RegKeyCurrentStateInt = ReadRegKeyVal(RegKeyStr)
  Debug.Print "RegKeyCurrentStateInt = " & RegKeyCurrentStateInt
 
  If RegKeyCurrentStateInt <> RegKeyDesiredStateInt Then
   Debug.Print "RegKeyCurrentStateInt <> RegKeyDesiredStateInt"
   Call SaveRegKey(RegKeyStr, RegKeyDesiredStateInt)
  Else
   Debug.Print "RegKeyCurrentStateInt = RegKeyDesiredStateInt"
  End If
 End If

End Sub