Bulk Move from OU to OU

[kachbo1]

Hi,

I have a list of users in an excel spreadsheet spread around in our AD.

I would like to bulk move them to a single OU.

I would appreciate if someone has a vbscript to achieve this.

Kachbo.

 

[markdmac]

Here you go.

'==========================================================================
'
' NAME: migrateUsers2OUstructure.vbs
'
' AUTHOR: Mark D. MacLachlan , The Spider's Parlor
' DATE  : 04/21/2003
' COPYRIGHT 2003 The Spider's Parlor, All Rights Reserved
'
' COMMENT: 
' moves users from standard User container to OU User container based on 
' Excel spreadsheet information.
' Excel spreadsheet  formatting:
' Column A to have new OU name, sample data: Flagstaff
' Column B user full name, sample data: John Smith
' Column C login name, sample data: jsmith
'=====================================
 

on error resume next

set x = getobject(,"excel.application")
r = 2

 do until len(x.cells(r, 1).value) = 0

    ou_name = x.cells(r, 1).value
    
    user_name =	x.cells(r, 2).value

    login_name = x.cells(r,3).value
    
    set o = getobject(path)



newpath = "LDAP://data_dc_1.companyname.org/OU=Users,OU=" & ou_name & ",DC=companyname,DC=org"

strUser = "LDAP://data_dc_1.companyname.org/CN=" & user_name & ",CN=Users,DC=companyname,DC=org"

Set oOU = GetObject(newpath)
oOU.MoveHere strUser, "CN=" & user_name                  ' IADsContainer

set objUser = GetUser2(login_name)
gpstr = "LDAP://data_dc_1.companyname.org/CN=" & ou_name & "_Users,OU=Users,OU=" & ou_name & ",DC=companyname,DC=org"
Set objGroup = GetObject(gpstr)
objGroup.Add objUser.ADsPath

Set oOU = Nothing

    r = r + 1
    
    'set o = nothing
    'set ou_name = Nothing
    'set user_name = Nothing
    
Err.Clear
loop

set x = nothing

msgbox "User Move Complete"


Public Function GetUser2(ByVal sAMAccountName)

    Dim ADCon,ADCmd,ADRec,str 

    Set ADCon = CreateObject("ADODB.Connection")
    Set ADCmd = CreateObject("ADODB.Command")

    ADCon.Provider = "ADsDSOObject"
    ADCon.Open "Active Directory Provider", UID, PWD

    Set ADCmd.ActiveConnection = ADCon
    ADCmd.Properties("Cache results") = False
    ADCmd.Properties("TimeOut") = 120

    str = "select sAMAccountName, ADsPath " & _
          "from '" & newpath &"' " & _
          "where objectCategory='person' and sAMAccountName='" & sAMAccountName & "'"

    ADCmd.CommandText = str

    Set ADRec = ADCmd.Execute()

    If ADRec.EOF Then
        Set objUser = Nothing
		Exit Function
    End If

    ' Then bind to the IADs object.

    Set GetUser2 = getObject(ADRec.Fields("adspath"))

End Function

I hope you find this post helpful.

Regards,

Mark