Script Inclusão de usuários em Grupo no AD

[Joelson Nascimento]

Fala galera,

Fiz um script em VBSCRIPT para incluir usuários em Grupos no AD a partir de um arquivo Excel, você entra com o nome do login e o nome do grupo e assim ira adicionar o usuario ao grupo solicitado, porém não está funcionando no momento apresenta o seguinte erro "The server is not operational", alguém poderia analizar o codigo e me ajudar?

' ------------------------------------------------------'

Option Explicit
Dim objRootLDAP, objContainer, objUser, objShell, objGroup
Dim objExcel, objSpread, intRow
Dim strUser, strOU, strSheet
Dim strCN, strPWD, strUserDN, strAcao, strError, strChamado,strgrupo


const strDomainDN = "DC=empresa,DC=timbrasil,DC=com,DC=br"


strSheet = "C:\ADScripts\grupo\Grupo.xls"

Set objExcel = CreateObject("Excel.Application")
Set objSpread = objExcel.Workbooks.Open(strSheet)

objExcel.Visible =true

intRow = 2 

Do Until objExcel.Cells(intRow,1).Value = ""
   strCN = Trim(objExcel.Cells(intRow, 1).Value)
   strUserDN = GetUserDNBysAMAccountName(strCN)
   strgrupo = Trim(objExcel.Cells(intRow, 2).Value)
        
   Dim bolReturn
   bolReturn = Grupo(strgrupo)
   if bolReturn then
       objExcel.Cells(intRow, 4).Value="OK"
   Else
       objExcel.Cells(intRow, 4).Value="NOK"
       objExcel.Cells(intRow, 5).Value=strError
       
   End If
   
   objExcel.Cells(intRow, 3).Value=strUserDN
   
intRow = intRow + 1
Loop
objExcel.Quit 

Function GetUserDNBysAMAccountName(byval strpUserLogonName)

    Dim objCon
    Dim objRs
    
    Dim strSQL
    
    Set objCon = createobject("ADODB.Connection")
    Set objRs = createobject("ADODB.Recordset")
    
        strSQL = "<LDAP://" & strDomainDN & ">;(sAMAccountName=" & strpUserLogonName & ");distinguishedName;subtree"
        objCon.Provider = "ADSDSOObject"
            
    call objCon.Open("ADs Provider")

    Set objRs = objCon.Execute(strSQL)
    
    if not objRs.EOF  then
        GetUserDNBysAMAccountName = objRs.Fields(0).Value
    else
        GetUserDNBysAMAccountName = ""
    end if
    
    Call objCon.Close
    
    set objCon = nothing
    set objRs = nothing
    
End Function

Function Grupo (byval strUserDN)

grupo = True

Const ADS_PROPERTY_APPEND = 3

Dim objGroup 
Set objGroup = GetObject ("LDAP://" & strUserDN)
objGroup.PutEx ADS_PROPERTY_APPEND, _ 
"member",Array  ("" & strgrupo & "")
objGroup.SetInfo

End Function

WScript.Quit

Obrigado!

Editado Janeiro 23, 2009 por kuroi
Adicionar tag CODE

[kuroi]

em qual linha aparece esse erro??

[Joelson Nascimento]

em qual linha aparece esse erro??

Linha: 79

Char: 1

Error: The server is not operational

Code:8007203A

Source: (null)

Obrigado!

[Joelson Nascimento]

Segue script atualizado e Funcionando .

---------------------------------------------------------------------------

'Declaração das constantes e variáveis

Const strDomainDN = "DC=empresa,DC=com,DC=br"

Const ADS_PROPERTY_APPEND = 3

Dim objRootLDAP, objContainer, objUser, objShell, objGroup

Dim objExcel, objSpread, intRow

Dim StrUser, strOU, strSheet

Dim strCN, strPWD, strAcao, strError, strChamado, strGroup

On Error Resume Next

'Abre a planilha

strSheet = "C:\Grupo.xls"

Set objExcel = CreateObject("Excel.Application")

Set objSpread = objExcel.Workbooks.Open(strSheet)

objExcel.Visible = True

'Verifica enquanto existem logins para verificar

intRow = 2

Do Until objExcel.Cells(intRow, 1).Value = ""

'pega o login da planilha

strCN = Trim(objExcel.Cells(intRow, 1).Value)

'pega a string do AD para o login

StrUser = GetUserDNBysAMAccountName(strCN)

'verifica se o usuário existe

If StrUser = False Then

objExcel.Cells(intRow, 4).Value = "NOK"

objExcel.Cells(intRow, 5).Value = "Usuário " & strError

Else

'pega o grupo da planilha

strGroup = Trim(objExcel.Cells(intRow, 2).Value)

'pega a string do grupo no AD

strGroup2 = GetUserDNBysAMAccountName(strGroup)

If strGroup2 = False Then

objExcel.Cells(intRow, 4).Value = "NOK"

objExcel.Cells(intRow, 5).Value = "Grupo " & strError

Else

Dim bolReturn

'verifica se o grupo existe, verifica se o usuário está no grupo, insere o usuário no grupo caso não esteja associado

bolReturn = Grupo(strGroup2, strCN, StrUser)

'verifica o retorno da função

If bolReturn Then

objExcel.Cells(intRow, 4).Value = "OK"

objExcel.Cells(intRow, 5).Value = "Usuário Incluido no Grupo"

Else

objExcel.Cells(intRow, 4).Value = "NOK"

objExcel.Cells(intRow, 5).Value = strError

End If

End If

objExcel.Cells(intRow, 3).Value = strGroup2

End If

intRow = intRow + 1

Loop

objExcel.ActiveWorkbook.Save

objExcel.Quit

Function GetUserDNBysAMAccountName(ByVal strpUserLogonName)

Dim objCon

Dim objRs

Dim strSQL

Set objCon = CreateObject("ADODB.Connection")

Set objRs = CreateObject("ADODB.Recordset")

strSQL = "<LDAP://" & strDomainDN & ">;(sAMAccountName=" & strpUserLogonName & ");distinguishedName;subtree"

objCon.Provider = "ADSDSOObject"

Call objCon.Open("ADs Provider")

Set objRs = objCon.Execute(strSQL)

If Not objRs.EOF Then

GetUserDNBysAMAccountName = objRs.Fields(0).Value

Else

strError = " Não Existe"

GetUserDNBysAMAccountName = False

Exit Function

End If

Call objCon.Close

Set objCon = Nothing

Set objRs = Nothing

End Function

Function GetUserDNByGroup(ByVal strGroup)

Dim objCon

Dim objRs

Dim strSQL

Set objCon = CreateObject("ADODB.Connection")

Set objRs = CreateObject("ADODB.Recordset")

strSQL = "<LDAP://" & strDomainDN & ">;(sAMAccountName=" & strpUserLogonName & ");distinguishedName;subtree"

objCon.Provider = "ADSDSOObject"

Call objCon.Open("ADs Provider")

Set objRs = objCon.Execute(strSQL)

If Not objRs.EOF Then

GetUserDNByGroup = objRs.Fields(0).Value

Else

GetUserDNByGroup = ""

End If

Call objCon.Close

Set objCon = Nothing

Set objRs = Nothing

End Function

Function Grupo(ByVal strGroup2, ByVal strCN, ByVal StrUser)

'On Error Resume Next

Grupo = True

'retorna o grupo do AD de acordo com a String

Set objGroup = GetObject("LDAP://" & strGroup2)

'retorna o usuário de acordo com a String

Set objUser = GetObject("LDAP://" & StrUser)

'verifica se o usuário pertence ao grupo

If IsArray(objUser.MemberOf) Then

colGroups = objUser.MemberOf

Else

colGroups = Array(objUser.MemberOf)

End If

For Each strGroupDN In colGroups

If strGroupDN = strGroup2 Then

strError = "Usuário já pertence ao grupo"

Grupo = False

Exit Function

End If

Next

'Incluir usuário no Grupo

objGroup.PutEx ADS_PROPERTY_APPEND, "member", Array(StrUser)

objGroup.SetInfo

If Err.Number <> 0 Then

strError = Err.Number & vbTab & Err.Description

Grupo = False

Exit Function

End If

End Function

WScript.Quit