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

Linha: 79 Char: 1 Error: The server is not operational Code:8007203A Source: (null) Obrigado!

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!