Меняем сервер печати у пользователей на VBScripts

Иногда бывает нужно перевести пользователей с одного сервера печати на другой. Если на новом сервере печати принтера имеют те же названия, что и на старом, то на VBScript реализовать это можно так.

'==========================================================================
'
' AUTHOR: Nefka
' DATE  : 17.10.2011
'
' COMMENT: Скрипт переключает принтеры с одного сервера на другой при запуске.
'
'==========================================================================
On Error Resume Next
 
'Имя сервера печати
oldSrvName="\\oldprnsrv"
newSrvName="\\newprnsrv"
 
'Получаем полное имя компьютера со всеми OU
Set objSysInfo = CreateObject("ADSystemInfo")
strComputer = objSysInfo.ComputerName
Set objSysInfo = Nothing
 
'Получаем имя принтера используемого по умолчанию
Set objShell = CreateObject("WScript.Shell")
strValue = "HKCU\Software\Microsoft\Windows NT\CurrentVersion\Windows\Device"
strDefPrinter = objShell.RegRead(strValue)
strDefPrinter = Split(strDefPrinter,",")(0)
 
 
Function AddPrint
    On Error Resume Next 
    Set WshNetwork = CreateObject("WScript.Network")
    Set Printers = WshNetwork.EnumPrinterConnections
    i = 0
    bPrn=False
    'Перечисляем принтеры
    While i<= Printers.Count-1
        PrnName = Printers.Item(i+1)
        'если мы нашли сетевой принтер со старого сервера печати
        If (InStr(PrnName,oldSrvName) = 1) Or (InStr(PrnName,LCase(oldSrvName)) = 1) Then
            'то формируем строку с именем нового сервера печати
            newPrinter = newSrvname & Mid(PrnName,Len(oldSrvName)+1)
            'если старый принтер был принтером по умолчанию, то и новый нужно сделать таким же
            If strDefPrinter = PrnName Then
                Err.Clear
                'добавляем принтер
                WshNetwork.AddWindowsPrinterConnection(newPrinter)
                If Err.Number <> 0 Then
                    strTelo = strComputer & Chr(13) & PrnName & Chr(13) & newPrinter
                    SendEmail "Произошла ошибка при добавлении принтера", strTelo
                Else 
                    strTelo = strComputer & Chr(13) & PrnName & Chr(13) & newPrinter
                    SendEmail "Успешная замена сервера печати",strTelo 
                    Err.Clear 
                    'устанавливаем принтер по умолчанию
                    WshNetwork.SetDefaultPrinter(newPrinter)
                    If Err.Number = 0 Then
                        strTelo = strComputer & Chr(13) & PrnName & Chr(13) & newPrinter & _
                            " is a default."
                        SendEmail "Принтер по умолчанию установлен",strTelo 
                        Err.Clear
                        'если все удачно, удаляем старый принтер
                        WshNetwork.RemovePrinterConnection(PrnName) 
                        If Err.Number = 0 Then
                            strTelo = strComputer & Chr(13) & PrnName & " is a default."
                            SendEmail "Принтер успешно удален",strTelo 
                        Else 
                            strTelo = strComputer & Chr(13) & PrnName & " is a default."
                            SendEmail "Возникла ошибка при удалении принтера",strTelo  
                        End If
                    Else
                        strTelo = strComputer & Chr(13) & PrnName & " is a default."
                        SendEmail "Не удалось установить принтер по умолчанию",strTelo 
                    End If 
                End If 
            Else
                Err.Clear
                'добавляем новый принтер
                WshNetwork.AddWindowsPrinterConnection newPrinter
                If Err.Number = 0 Then
                    strTelo = strComputer & Chr(13) & PrnName & Chr(13) & newPrinter
                    SendEmail "Успешная замена сервера печати",strTelo 
                    Err.Clear
                    'если все удачно, удаляем старый принтер
                    WshNetwork.RemovePrinterConnection(PrnName)
                    If Err.Number = 0 Then
                        strTelo = strComputer & Chr(13) & PrnName
                        SendEmail "Принтер успешно удален",strTelo 
                    Else
                        strTelo = strComputer & Chr(13) & PrnName
                        SendEmail "Возникла ошибка при удалении принтера",strTelo 
                    End If 
                Else
                    strTelo = strComputer & Chr(13) & PrnName
                    SendEmail "Успешная замена сервера печати",strTelo    
                End If 
            End If 
        End If 
       i=i+2
    Wend
End Function
 
'функция отправляет письма через внутренний почтовый сервер
Sub SendEmail (theme,strT)
    sUName = objShell.ExpandEnvironmentStrings("%USERNAME%")
    Set objEmail = CreateObject("CDO.Message")
    objEmail.From = sUname&"@local.man"
    objEmail.To = "admin@local.man"
    objEmail.Subject = theme
    objEmail.Textbody = strT 
    objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/" & _
        "configuration/sendusing") = 2
    objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/" & _
        "configuration/smtpserver") ="ex1.local.man" 
    objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/" & _
        "configuration/smtpserverport") = 25
    objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/" & _
        "configuration/smtpusessl") = False
    objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/" & _
        configuration/smtpauthenticate")=2
    objEmail.Configuration.Fields.Update
    objEmail.Send
    Set objEmail = Nothing
End Sub 
 
 AddPrint 'выполняем
 
Set objShell = Nothing 
 
WScript.Quit 0