Вот народ что получилось! Спасибо всем за помощь. Мапит диски, принтеры, вносит изменения в регистр.
Код: Option Explicit
'On Error Resume Next
Dim WshShell, WshNetwork
Dim strUserDN, objSysInfo, GroupObj, UserGroups, UserObj, Printers
' Задаем имя файлового сервера, при использовании нескольких серверов
' создаем несколько констант и используем их при вызове MapDrv
Const FileSrv1 = "\\SRV2"
Const FileSrv2 = "\\SRV5"
UserGroups=""
Set WshShell = WScript.CreateObject("WScript.Shell")
Set WshNetwork = WScript.CreateObject("WScript.Network")
Set objSysInfo = CreateObject("ADSystemInfo")
Set Printers = WshNetwork.EnumPrinterConnections
strUserDN = objSysInfo.userName
Set UserObj = GetObject("LDAP://" & strUserDN)
For Each GroupObj In UserObj.Groups
UserGroups=UserGroups & "[" & GroupObj.Name & "]"
Next
'MsgBox "Member of "& UserGroups
if InGroup("KlientBank") then
MapDrv "J:", FileSrv2 & "\notes$","Клиент Банк"
WshNetwork.AddWindowsPrinterConnection "\\SRV5\HP2420"
WshNetwork.SetDefaultPrinter "\\SRV5\HP2420"
end if
WSHShell.Run "regedit /s 1C.reg",2
MapDrv "S:", FileSrv2 & "\Soft$", "Программы"
MapDrv "O:", FileSrv2 & "\Documents$","Документы"
MapDrv "W:", FileSrv2 & "\1C$","1С"
'==========================================================================
' Далее ничего не трогаем!!
Function MapDrv(DrvLet, UNCPath, DrvName)
Dim objFSO, oShell ' Object variable
Dim Msg
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set oShell = CreateObject("Shell.Application")
On Error Resume Next
If objFSO.DriveExists(DrvLet) Then
WshNetwork.RemoveNetworkDrive DrvLet, true, true
End If
WshNetwork.MapNetworkDrive DrvLet, UNCPath
oShell.NameSpace(DrvLet).Self.Name = DrvName
Select Case Err.Number
Case 0 ' No error
Case -2147023694
WshNetwork.RemoveNetworkDrive DrvLet, true, true
WshNetwork.MapNetworkDrive DrvLet, UNCPath
oShell.NameSpace(DrvLet).Self.Name = DrvName
Case -2147024811
WshNetwork.RemoveNetworkDrive DrvLet, true, true
WshNetwork.MapNetworkDrive DrvLet, UNCPath
oShell.NameSpace(DrvLet).Self.Name = DrvName
Case Else
Msg = "Mapping network drive error: " & _
CStr(Err.Number) & " 0x" & Hex(Err.Number) & vbCrLf & _
"Error description: " & Err.Description & vbCrLf
Msg = Msg & "Domain: " & WshNetwork.UserDomain & vbCrLf
Msg = Msg & "Computer Name: " & WshNetwork.ComputerName & vbCrLf
Msg = Msg & "User Name: " & WshNetwork.UserName & vbCrLf & vbCrLf
Msg = Msg & "Device name: " & DrvLet & vbCrLf
Msg = Msg & "Map path: " & UNCPath
WshShell.LogEvent 1, Msg, FileSrv1
End Select
End Function
'==========================================================================
Function InGroup(strGroup)
InGroup=False
If InStr(UserGroups,"[CN=" & strGroup & "]") Then
InGroup=True
End If
End Function
