const HKEY_CURRENT_USER = &H80000001 
Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv") 

'Строка в реестре, где хранятся настйроки мессенгера 

strKeyPath = "Software\Microsoft\MessengerService" 

'Массив определяет признак "включено" для опций мессенгера 
Dim strValue( 3 ) 
strValue( 0 ) =  1  
strValue( 1 ) =  0  
strValue( 2 ) =  0  
strValue( 3 ) =  0  


Set WshShell = Wscript.CreateObject("Wscript.Shell") 

'Далее идет получение SIP пользователя 
strAccount = WshShell.ExpandEnvironmentStrings("%username%") 
Set objConnection = CreateObject("ADODB.Connection") 
objConnection.Open "Provider=ADsDSOObject;" 
Set objCommand = CreateObject("ADODB.Command") 
objCommand.ActiveConnection = objConnection 
objCommand.CommandText = _ 
"<LDAP://dc=our,dc=domain>;(&(objectCategory=User)" & _ 
"(samAccountName=" & strAccount & "));samAccountName,msRTCSIP-PrimaryUserAddress,distinguishedName;subtree" 

Set objRecordSet = objCommand.Execute 
If objRecordset.RecordCount <> 0 Then 
strRTCSip = objRecordset.Fields("msRTCSIP-PrimaryUserAddress") 
If strRTCSip<>"" Then 
'Нашли SIP, прописываем в реестре 
oReg.CreateKey HKEY_CURRENT_USER,strKeyPath 
oReg.SetBinaryValue HKEY_CURRENT_USER,strKeyPath,"RTCState",strValue 
oReg.SetStringValue HKEY_CURRENT_USER,strKeyPath,"UserMicrosoft RTC Instant Messaging",strRTCSip 
strRes = "Настроен SIP " & strRTCSip 
Else 
strRes = "Учетная запись SIP не найдена" 
End If