Solved

Remove a User Script Modification

Posted on 2011-03-17
7
282 Views
Last Modified: 2012-06-27
Hello - I found this script to run to remove users from a group but I'm getting the attached error. How should I setup the Excel sheet (Users.xlsx) so the script can read it?

' Remove a User from a Group


Const ADS_PROPERTY_DELETE = 4
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Const ADS_NAME_INITTYPE_GC = 3
Const ADS_NAME_TYPE_NT4 = 3
Const ADS_NAME_TYPE_1779 = 1

'*****************************
' Modify these to suit your needs
'*****************************
strNetBIOSdomain = "VHA05.med.va.gov"
strExcelPath = "C:\TestScriptForRemovingUsers\Users.xlsx"
'Start on Row 2 - Assume Column headers
IntRow = 2

Set objTrans = CreateObject("NameTranslate")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("Wscript.Shell")
Set objResults = objFSO.OpenTextFile("Group-Results.txt", ForWriting)
'*****************************
' Determine DNS domain name from RootDSE object.
'*****************************
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("DefaultNamingContext")
'*****************************
' Open spreadsheet.
'*****************************
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True

'On Error Resume Next
objExcel.Workbooks.Open strExcelPath
If Err.Number <> 0 Then
  On Error GoTo 0
  Wscript.Echo "Unable to open spreadsheet: " & strExcelPath
  Wscript.Quit
End If
On Error GoTo 0
Set objSheet = objExcel.ActiveWorkbook.Worksheets(1)

' Read each row of spreadsheet until a blank value
' encountered in column 1 (the column for SAMAccountName).
' For each row, create group and set attribute values.

Do While objSheet.Cells(intRow, 1).Value <> ""
  ' Read values from spreadsheet for this group.
  strUserID = Trim(objSheet.Cells(intRow, 1).Value)
  StrGroupID = Trim(objSheet.Cells(intRow, 2).Value)

'*****************************
' Use the NameTranslate object to find the NetBIOS domain name
' from the DNS domain name.
'*****************************

      objTrans.Init ADS_NAME_INITTYPE_GC, ""
      objTrans.Set ADS_NAME_TYPE_NT4, strNetBIOSdomain & "\" & strUserID
      strUserDN = objTrans.Get(ADS_NAME_TYPE_1779)

      objTrans.Init ADS_NAME_INITTYPE_GC, ""
      objTrans.Set ADS_NAME_TYPE_NT4, strNetBIOSdomain & "\" & strGroupID
      strGroupDN = objTrans.Get(ADS_NAME_TYPE_1779)
      
      Set objGroup = GetObject("LDAP://" & strGroupDN)
      'objGroup.Remove("LDAP://" & strUserDN)
      objGroup.PutEx ADS_PROPERTY_DELETE ("LDAP://" & strUserDN)

      objGroup.SetInfo
      If err.Number <> 0 Then
            objResults.writeline strUserID & " failed to remove from " & strGroupID
            err.Clear
      Else
        objResults.writeline "Removed: " & strUserDN & vbTab & strGroupDN
      End If
      
      
IntRow = IntRow + 1
Loop

WScript.Echo "Done"
Error.docx
0
Comment
Question by:vhaperbaugub
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 3
  • 3
7 Comments
 
LVL 8

Expert Comment

by:Pearl_export_ben
ID: 35158694
Hi There,

To begin with, I dont think its a problem with your spreadsheet.

From looking at the error (Line 58), your error appears to be with the nametranslate call.

The error suggests that the script is unable to resolve a username from your netbios domain name or that you dont have permissions to run that sort of query from your user account/computer.

Can you use an msgbox to check that the username and domain name are correct as part of the lookup and get back to me?

Ben
0
 

Author Comment

by:vhaperbaugub
ID: 35159435
I'm not sure how to add a msgbox to the script. Can you add that please and I'll test it.
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 35161550
Hi, try this.  It doesn't use the NameTranslate, but rather an AD search.

Regards,

Rob.
'Remove a User from a Group

'*****************************
' Modify these to suit your needs
'*****************************
strExcelPath = "C:\TestScriptForRemovingUsers\Users.xlsx"
'Start on Row 2 - Assume Column headers
IntRow = 2

Const ForWriting = 2
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objResults = objFSO.OpenTextFile("Group-Results.txt", ForWriting, True)
'*****************************
' Determine DNS domain name from RootDSE object.
'*****************************
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("DefaultNamingContext")
'*****************************
' Open spreadsheet.
'*****************************
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True

'On Error Resume Next
Set objWB = objExcel.Workbooks.Open(strExcelPath, False, False)
If Err.Number <> 0 Then
	On Error GoTo 0
	Wscript.Echo "Unable to open spreadsheet: " & strExcelPath
	objExcel.Quit
	Wscript.Quit
End If
On Error GoTo 0
Set objSheet = objWB.Worksheets(1)

' Read each row of spreadsheet until a blank value
' encountered in column 1 (the column for SAMAccountName).
' For each row, create group and set attribute values.

Do While objSheet.Cells(intRow, 1).Value <> ""
	' Read values from spreadsheet for this group.
	strUserID = Trim(objSheet.Cells(intRow, 1).Value)
	StrGroupID = Trim(objSheet.Cells(intRow, 2).Value)
	
	If strUserID <> "" And strGroupID <> "" Then
		strUserDN = Get_LDAP_User_Properties("user", "samaccountname", strUserID, "adsPath")
		strGroupDN = Get_LDAP_User_Properties("user", "name", strGroupID, "adsPath")
		If strUserDN <> "" Then
			If strGroupDN <> "" Then
				Set objGroup = GetObject(strGroupDN)
				On Error Resume Next
				objGroup.Remove strUserDN
				'objGroup.PutEx ADS_PROPERTY_DELETE ("LDAP://" & strUserDN)
				'objGroup.SetInfo
				If err.Number <> 0 Then
					objResults.writeline strUserID & " failed to remove from " & strGroupID
					err.Clear
				Else
					objResults.writeline "Removed: " & strUserDN & vbTab & strGroupDN
				End If
				Err.Clear
				On Error GoTo 0
			Else
				objResults.writeline "Could not find " & strGroupID
			End If
		Else
			objResults.writeline "Could not find " & strUserID
		End If
	End If
	
	IntRow = IntRow + 1
Loop
objWB.Close
objExcel.Quit
objResults.Close
WScript.Echo "Done"

Function Get_LDAP_User_Properties(strObjectType, strSearchField, strObjectToGet, strCommaDelimProps)
      
      ' This is a custom function that connects to the Active Directory, and returns the specific
      ' Active Directory attribute value, of a specific Object.
      ' strObjectType: usually "User" or "Computer"
      ' strSearchField: the field by which to seach the AD by. This acts like an SQL Query's WHERE clause.
      '				It filters the results by the value of strObjectToGet
      ' strObjectToGet: the value by which the results are filtered by, according the strSearchField.
      '				For example, if you are searching based on the user account name, strSearchField
      '				would be "samAccountName", and strObjectToGet would be that speicific account name,
      '				such as "jsmith".  This equates to "WHERE 'samAccountName' = 'jsmith'"
      '	strCommaDelimProps: the field from the object to actually return.  For example, if you wanted
      '				the home folder path, as defined by the AD, for a specific user, this would be
      '				"homeDirectory".  If you want to return the ADsPath so that you can bind to that
      '				user and get your own parameters from them, then use "ADsPath" as a return string,
      '				then bind to the user: Set objUser = GetObject("LDAP://" & strReturnADsPath)
      
      ' Now we're checking if the user account passed may have a domain already specified,
      ' in which case we connect to that domain in AD, instead of the default one.
      If InStr(strObjectToGet, "\") > 0 Then
            arrGroupBits = Split(strObjectToGet, "\")
            strDC = arrGroupBits(0)
            strDNSDomain = strDC & "/" & "DC=" & Replace(Mid(strDC, InStr(strDC, ".") + 1), ".", ",DC=")
            strObjectToGet = arrGroupBits(1)
      Else
      ' Otherwise we just connect to the default domain
            Set objRootDSE = GetObject("LDAP://RootDSE")
            strDNSDomain = objRootDSE.Get("defaultNamingContext")
      End If
 
      strBase = "<LDAP://" & strDNSDomain & ">"
      ' Setup ADO objects.
      Set adoCommand = CreateObject("ADODB.Command")
      Set adoConnection = CreateObject("ADODB.Connection")
      adoConnection.Provider = "ADsDSOObject"
      adoConnection.Open "Active Directory Provider"
      adoCommand.ActiveConnection = adoConnection
 
 
      ' Filter on user objects.
      'strFilter = "(&(objectCategory=person)(objectClass=user))"
      strFilter = "(&(objectClass=" & strObjectType & ")(" & strSearchField & "=" & strObjectToGet & "))"
 
      ' Comma delimited list of attribute values to retrieve.
      strAttributes = strCommaDelimProps
      arrProperties = Split(strCommaDelimProps, ",")
 
      ' Construct the LDAP syntax query.
      strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
      adoCommand.CommandText = strQuery
      ' Define the maximum records to return
      adoCommand.Properties("Page Size") = 100
      adoCommand.Properties("Timeout") = 30
      adoCommand.Properties("Cache Results") = False
 
      ' Run the query.
      Set adoRecordset = adoCommand.Execute
      ' Enumerate the resulting recordset.
      strReturnVal = ""
      Do Until adoRecordset.EOF
          ' Retrieve values and display.    
          For intCount = LBound(arrProperties) To UBound(arrProperties)
                If strReturnVal = "" Then
                      strReturnVal = adoRecordset.Fields(intCount).Value
                Else
                      strReturnVal = strReturnVal & VbCrLf & adoRecordset.Fields(intCount).Value
                End If
          Next
          ' Move to the next record in the recordset.
          adoRecordset.MoveNext
      Loop
 
      ' Clean up.
      adoRecordset.Close
      adoConnection.Close
      Get_LDAP_User_Properties = strReturnVal
	 
End Function

Open in new window

0
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 

Author Comment

by:vhaperbaugub
ID: 35169559
Hello - I'm getting the attached error when I run the script.
Error.docx
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 35169919
Above this line:
      adoCommand.CommandText = strQuery

please put
MsgBox "About to run: "&  VbCrLf & strQuery

and confirm that the query structure is correct.

Regards,

Rob.
0
 

Author Comment

by:vhaperbaugub
ID: 35172538
Ok, that seemed to fix it....is there a way for the script to run continuosly without prompting about what its going to do next? Thanks
0
 
LVL 65

Accepted Solution

by:
RobSampson earned 500 total points
ID: 35173807
What sort of prompt?  You mean the one you just added?

Put an apostrophe in front of the line you just added, to comment it out.

Regards,

Rob.
0

Featured Post

Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article is the result of a quest to better understand Task Scheduler 2.0 and all the newer objects available in vbscript in this version over  the limited options we had scripting in Task Scheduler 1.0.  As I started my journey of knowledge I f…
Deploying a Microsoft Access application in a Citrix environment is not difficult but takes a few steps. However, Citrix system people are often of little help, as they typically know next to nothing about Access. The script provided here will take …
Nobody understands Phishing better than an anti-spam company. That’s why we are providing Phishing Awareness Training to our customers. According to a report by Verizon, only 3% of targeted users report malicious emails to management. With compan…

734 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question