Read and write from/to registry in VBA
Asked Answered
P

3

10

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
Placentation answered 2/9, 2015 at 5:28 Comment(9)
The VBA equivalent should be .RegWrite "HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Services\USBSTOR\Start", 4, "REG_DWORD". But this will only work if the user which runs the VBA has rights to change the registry at HKEY_LOCAL_MACHINE.Appalachian
Interesting read for you....Amygdalin
Alex: I changed my code to reflect your input on the matter. But I'm still getting the -2147024891[80070005] invalid root error. Is this because the VBA script is not running elevated? As a user I have the rights to change the registry. Maybe I should instead use ShellExecute to send the command.... ...I'm out of my league here, so pardon me if I'm saying silly things.Placentation
Siddarth: I read it and it gave me some insight on what I'm actually doing.Placentation
Siddarth & Axel: I think I now undertand why I am getting that error. There is no registry entry in USBSTOR named Start, only one named Count.Placentation
Using count I still get the same error...Placentation
Update: Nevermind that count thing... I got it: start is a NameValue in the USBSTOR folder. So using cmd I typed in > /k %windir%\System32\reg.exe ADD HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Services\USBSTOR /f /v Start /t REG_DWORD /d 4 /f", "C:\", 1 And, cutting the story short: I'm still getting an error....Placentation
Axel: Your answer seems to be correct (I think the macro simply lacks the necessary permissions).Placentation
Axel and Siddarth, Thank you both for your help. This question is now solved.Placentation
P
14

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
Placentation answered 3/9, 2015 at 7:47 Comment(0)
E
5

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://learn.microsoft.com/en-us/office/vba/language/reference/user-interface-help/getsetting-function

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

https://learn.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
Ejaculate answered 1/7, 2021 at 21:54 Comment(0)
F
0

There must be a "\" after the word Start in the registry key.

Flossie answered 22/3, 2021 at 12:43 Comment(0)

© 2022 - 2024 — McMap. All rights reserved.