[Iska]

Но на вопрос-то Вы не ответили — будет ли этого достаточно?

Ладно… Вот Вам на всякий случай ещё один код, который пытается перебирать все подразделы в …\Profiles, а не только указанный как умолчальный:

Код:

Option Explicit

Const HKEY_CURRENT_USER = &H80000001

Dim arrSubKeysProfiles
Dim strSubKeyProfile

Dim arrSubKeysEntries
Dim strSubKeyEntry

Dim lngValue


With WScript.CreateObject("WbemScripting.SWbemLocator").ConnectServer(".", "root\default").Get("StdRegProv")
	If .EnumKey(HKEY_CURRENT_USER, "Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles", arrSubKeysProfiles) = 0 Then
		For Each strSubKeyProfile In arrSubKeysProfiles
			If .EnumKey(HKEY_CURRENT_USER, "Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles\" & strSubKeyProfile & "\9375CFF0413111d3B88A00104B2A6676", arrSubKeysEntries) = 0 Then
				For Each strSubKeyEntry In arrSubKeysEntries
					If .GetDWORDValue(HKEY_CURRENT_USER, "Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles\" & strSubKeyProfile & "\9375CFF0413111d3B88A00104B2A6676\" & strSubKeyEntry, "Leave on Server", lngValue) = 0 Then
						If lngValue <> 0 Then
							If .SetDWORDValue(HKEY_CURRENT_USER, "Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles\" & strSubKeyProfile & "\9375CFF0413111d3B88A00104B2A6676\" & strSubKeyEntry, "Leave on Server", 0) = 0 Then
								WScript.Echo "Successfully set parameter [Leave on Server] of subkey [HKCU\Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles\" & strSubKeyProfile & "\9375CFF0413111d3B88A00104B2A6676\" & strSubKeyEntry & "] to [0]."
							Else
								WScript.Echo "Failure set parameter [Leave on Server] of subkey [HKCU\Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles\" & strSubKeyProfile & "\9375CFF0413111d3B88A00104B2A6676\" & strSubKeyEntry & "] to [0]."
							End If
						End If
					End If
				Next
			Else
				WScript.Echo "Can't enumerate subkeys on [HKCU\Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles\" & strSubKeyProfile & "\9375CFF0413111d3B88A00104B2A6676]."
				WScript.Quit 2
			End If
		Next
	Else
		WScript.Echo "Can't enumerate subkeys on [HKCU\Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles]."
		WScript.Quit 1
	End If
End With

WScript.Quit 0