Updated: Copy DLs from one user to another
The first version of the script really was quick and dirty, requiring you to manually put the source and target users’ DNs in the script. Since a coworker has been using the script, I thought it appropriate to update it to prompt for the usernames. In addition, I added a new feature I recently read about, which is to output the results in real-time to a GUI. This is done by creating an object for IE and writing the output similar to wscript.echo, but with the Write method of the object.
Like the original script, since we use automated DLs, too, I look for an indication that a given DL is a SmartDL and skip it. And I now use PrimalScript to work with my scripts, so I use its packager to make an exectuable. This makes it easier and nicer for non-IT end-users who will be running scripts like these.
Download it here, or copy/paste below.
'Version 2.0 - July 23, 2007
'Copy distribution group membership from one user to another,
'excluding automated DLs (SmartDL).
'Get source user
While Not bolExit = True
strOldSamUser = InputBox("Enter the sAMAccountName of the person to copy DLs FROM." _
, "Enter username")
If strOldSamUser = "" Then
WScript.Quit
End If
'Find the Global Catalog server
Set objCont = GetObject("GC:")
For Each objGC In objCont
strADsPath = objGC.ADsPath
Next
Set objConnection = CreateObject("ADODB.Connection")
Set objRecordset = CreateObject("ADODB.Recordset")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "ADs Provider"
strQuery = "<" & strADsPath & ">;(&(objectcategory=user)(sAMAccountName=" & strOldSamUser & _
"));displayName,distinguishedName;subtree"
Set objRecordset = objConnection.Execute(strQuery)
If Trim(objRecordset.Fields("distinguishedName")) = "" Then
strNoUser = MsgBox("Warning: User cannot be found. Verify sAMAccountName.", vbCritical, "User not found!")
bolExit = False
Else
intCorrectUser = MsgBox("Is this the correct user?" & VbCrLf & VbCrLf & "Display Name: " & _
objRecordset.Fields("displayName") & VbCrLf & "DN: " & objRecordset.Fields("distinguishedName"), _
vbYesNo, "Old user?")
If intCorrectUser <> 6 Then
bolExit = False
Else
strSrcDN = objRecordset.Fields("distinguishedName")
bolExit = True
End If
End If
Wend
'Open IE to display progress and results
Set objIE = CreateObject("InternetExplorer.Application")
objIE.AddressBar = False
objIE.Menubar = False
objIE.Toolbar = False
objIE.Resizable = True
objIE.Left = 10
objIE.Height = 450
objIE.Width = 800
objIE.Visible = True
objIE.Navigate("about:blank")
While objIE.Busy
WScript.Sleep 100
Wend
Set objDoc = objIE.Document
objDoc.Open
objDoc.Write("<TITLE>Copy DL Membership</TITLE>")
objDoc.Write("<BODY BGCOLOR=#C0C0C0>")
objDoc.Write("<P><b>Source:</b> " & objRecordset.Fields("distinguishedName") & "<br>")
'Get target user
bolExit = False
While Not bolExit = True
strNewSamUser = InputBox("Enter the sAMAccountName of the person to copy DLs TO." _
, "Enter username")
If strNewSamUser = "" Then
objIE.Quit
WScript.Quit
End If
strQuery = "<" & strADsPath & ">;(&(objectcategory=user)(sAMAccountName=" & strNewSamUser & _
"));displayName,distinguishedName;subtree"
Set objRecordset = objConnection.Execute(strQuery)
If Trim(objRecordset.Fields("distinguishedName")) = "" Then
strNoUser = MsgBox("Warning: User cannot be found. Verify sAMAccountName.", vbCritical, "User not found!")
bolExit = False
Else
intCorrectUser = MsgBox("Is this the correct user?" & VbCrLf & VbCrLf & "Display Name: " & _
objRecordset.Fields("displayName") & VbCrLf & "DN: " & objRecordset.Fields("distinguishedName"), _
vbYesNo, "Old user?")
If intCorrectUser <> 6 Then
bolExit = False
Else
Set objTargetUser = GetObject("LDAP://" & objRecordset.Fields("distinguishedName"))
bolExit = True
End If
End If
Wend
'Write target user to IE window
objDoc.Write("<b>Target:</b> " & objRecordset.Fields("distinguishedName") & "</P>")
'Copy DLs
strDomFQDN = Mid(strSrcDN, InStr(LCase(strSrcDN), ",dc=") + 4)
strGCFQDN = Replace(LCase(strDomFQDN), ",dc=", ".")
Set objOldUser = GetObject("GC://" & strGCFQDN & "/" & strSrcDN)
For Each strGroup in objOldUser.MemberOf
On Error Resume Next
Set objGroup = GetObject("LDAP://" & strGroup)
If Not Trim(objGroup.mailNickname) = "" Then
If Not Instr(objGroup.info, "SmartDL") > 0 Then
objGroup.Add(objTargetUser.ADsPath)
If Err.Number = 0 Then
objDoc.Write(objGroup.DisplayName & ": Update successful.<br>")
Else
objDoc.Write(objGroup.DisplayName & ": Update UNSUCCESSFUL.<br>")
End If
Else
objDoc.Write(objGroup.DisplayName & ": Skipped (SmartDL).<br>")
End If
End If
On Error Goto 0
Next
Set objOldUser = Nothing
Set objTargetUser = Nothing
Set objIE = Nothing
Set objRecordset = Nothing
Set objConnection = Nothing
Themocracy