Чтение и запись из/в реестр в VBA

Я думаю, что проблема здесь была в том, что у макроса не было разрешения на запись в реестр.

Дополнительные сведения см. на этой странице. Я мог бы просто прочитать значение ключа, используя объект WScript:

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

Чтобы написать (это должно работать, если у вас есть разрешения):

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

Как я заставил его работать (поскольку мой скрипт, похоже, не имеет необходимых разрешений):

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

В этом последнем примере пользователю будет предложено предоставить необходимое разрешение.

PS: HKLM — это сокращение от HKEY_LOCAL_MACHINE. Все остальные имена корневых ключей имеют аналогичные сокращения, с которыми можно ознакомиться в страница, упомянутая вверху.

В качестве практического примера я опубликую свое использование этих выражений для включения/отключения запоминающего устройства USB (когда включено, когда выключено):

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

После слова Start в ключе реестра должен стоять \.

Вот мой общий код VBA для работы с реестром Windows.

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

Пример вызова 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