Подключение сетевых принтеров скриптом VB

Весь MS Office, программирование на Visual Basic for Applications и MS VB

Модератор: Naeel Maqsudov

Ответить
RomaS
Сообщения: 57
Зарегистрирован: 05 мар 2008, 09:59

Здравствуйте!
Вроде в правильный раздел написал?) Задача такая:

сеть с доменом на сервере 2003, логон-скриптом надо подключать сетевые принтеры (расшареные на раб машинах и сетевые) подключать согласно указанному в AD расположению (Location) принтеров и компов (в виде: офис/отдел/...)

Пытался найти готовые скрипты - нашел несколько, но или не работают или не совсем то что хотелось бы... попробовал переделать под себя..

например этот:

Код: Выделить всё

'Скрипт подключения принтеров на рабочих станциях 
'Версия: 20050803 1728 alfa (проходит тестирование) 

'ищет все опубликованные принтеры в домене и присоединяет те у которых поле location либо совпадает с компьютером либо принтер на уровень выше 
'для работы скрипта необходимо 
' - заполнить поле Location у принтеров 
' - для OU в котором находится компьютер назначить месторасположение в Computer Configuration/Administrative Templates/Printers/Computer Location 
' пример поля Локеишн: Офис/5-й этаж/505 кабинет - для компьютера или принтера в кабинете 505. Офис/5-й этаж - для общего принтера на пятом этаже 

'настройка: заменить строку "DC=intranet,DC=domain,DC=local" на соответствующую вашему домену. 
' 
'© cjnovi at gmail dot com (баги, идеи, пожелания сюда) 

On Error Resume Next 

Set objShell = CreateObject("WScript.Shell") 
Set objNetwork = CreateObject("WScript.Network") 

Private Function IsLocation( computerLocation, printerLocation) 
printerLocation = trim(lCase(printerLocation)) 
computerLocation = trim(lCase(computerLocation)) 

If Not len(printerLocation) And Not (computerLocation = "terminal") Then 
pL = printerLocation 
cL = computerLocation 
If (pL = cL) Then IsLocation = True 
a = False 
Do Until a 
cL = mid(cL,InStr(cL,"/")+1,len(cL)-InStr(cL,"/")+1) 
if (InStr(cL,"/") = 0) Then a = True 
Loop 
cL = left(computerLocation,len(computerLocation)-len(cL)-1) 
if (pL = cL) Then IsLocation = True 
End If 

End Function 

strComputer = "." 

'get Computer Location 
const HKEY_LOCAL_MACHINE = &H80000002 
Set oReg=GetObject( "winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv") 
strKeyPath = "SOFTWARE\Policies\Microsoft\Windows NT\Printers" 
strValueName = "PhysicalLocation" 
oReg.GetStringValue HKEY_LOCAL_MACHINE,strKeyPath,strValueName,computerLocation 

'delete all connected network printers 
Set objWMIService = GetObject("winmgmts:" _ 
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2") 
Set colInstalledPrinters = objWMIService.ExecQuery ("Select * from Win32_Printer") 


For Each objPrinter in colInstalledPrinters 
If (left(objPrinter.Name,2) = "\\") Then objNetwork.RemovePrinterConnection objPrinter.Name ' objPrinter.serverName & "\" & objPrinter.shareName 
'if ((left(objPrinter.Name,2) = "\\") And Not (IsLocation(computerLocation,objPrinter.Location))) then objNetwork.RemovePrinterConnection objPrinter.Name 
Next 

'enumerate AD printers 
Const ADS_SCOPE_SUBTREE = 2 
Set objConnection = CreateObject("ADODB.Connection") 
Set objCommand = CreateObject("ADODB.Command") 
objConnection.Provider = "ADsDSOObject" 
objConnection.Open "Active Directory Provider" 
Set objCommand.ActiveConnection = objConnection 
objCommand.CommandText = "SELECT serverName, Location, UNCName FROM " _ 
& " 'LDAP://OU=Domain Controllers,DC=intranet,DC=domain,DC=local' WHERE objectClass='printQueue'" 
objCommand.Properties("Page Size") = 1000 
objCommand.Properties("Timeout") = 30 
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE 
objCommand.Properties("Cache Results") = False 
Set objRecordSet = objCommand.Execute 
objRecordSet.MoveFirst 
Do Until objRecordSet.EOF 
printerLocation = objRecordSet.Fields("Location").Value 
printerShare = objRecordSet.Fields("UNCName").Value 
if IsLocation(computerLocation,printerLocation) Then objNetwork.AddWindowsPrinterConnection printerShare 
objRecordSet.MoveNext 
Loop 
Проблему с указанием домена в запросе решил так:

Код: Выделить всё

Set objSysInfo = CreateObject("ADSystemInfo")
strUserDN = objSysInfo.UserName
strCompDN = objSysInfo.ComputerName
Set objUser = GetObject("LDAP://" & strUserDN)
Set objComp = GetObject("LDAP://" & strCompDN)
Full_DC_Name="'LDAP://OU=Domain Controllers," & mid(strCompDN,InStr(strCompDN,"DC="),len(strCompDN)) & "'"
...........

objCommand.CommandText = "SELECT serverName, Location, UNCName FROM " _ 
& Full_DC_Name & " WHERE objectClass='printQueue'"
Но! Здесь расположение компов берется из реестра, а хотелось бы из "актив директори". Так же как и расположение принтеров.
Т.е. по аналогии надо заменить
objectClass='printQueue' на objectClass='computer'
А как это все объединить? Как добавить второй запрос LDAP или как еще?
RomaS
Сообщения: 57
Зарегистрирован: 05 мар 2008, 09:59

Вот этот код, кстати, и показавает локашен рабочей станции из актив директори. Но опять, же как все в одно собрать??

Код: Выделить всё

Option Explicit
	
Dim objConnection, objCommand, objRecordSet, objComputer
Const ADS_SCOPE_SUBTREE = 2
	
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand =   CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"

Set objCOmmand.ActiveConnection = objConnection
objCommand.CommandText = _
"Select Name, Location from 'LDAP://DC=..........,DC=.......' " _
  & "Where objectClass='computer'"  
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE 
Set objRecordSet = objCommand.Execute
objRecordSet.MoveFirst
	
Do Until objRecordSet.EOF
	
msgbox "Computer Name: " & objRecordSet.Fields("Name").Value & vbnewline & _
"Location: " & objRecordSet.Fields("Location").Value
objRecordSet.MoveNext
Loop
--------------------------------------------------------------------------------
Добавлено сообщение
--------------------------------------------------------------------------------
ну в общем, пока ничего лучше не придумал, как вставить в две разные функции...
Ответить