根据计算机帐号，将其自动的移动到相应的OU脚本
很多的企业都有这样的要求：希望整理自己的computers容器中的计算机，根据计算机名将其添加到对应的OU中去，但如果由人力来实现的话，工作量非常大，所以，在这次给某个企业实施项目的时候，我随手写了一个脚本，该脚本会自动将计算机加入到对应的OU中去。用户可以自己改写一下脚本，以适应自己的情况，我的脚本里对计算机名截取了2个字符。
dim strADsPath
dim sResultText
Const ADS_SCOPE_SUBTREE = 2
Set con = CreateObject("ADODB.Connection")
Set com = CreateObject("ADODB.Command")
'Open the connection with the ADSI-OLEDB provider name
con.Provider = "ADsDSOObject"
con.Open
Com.ActiveConnection = con
Com.CommandText = "<LDAP://cn=computers,DC=contoso,DC=com>;" & "(objectClass=computer);name;subTree"
Set rs = Com.Execute()
i=0
Do Until rs.EOF
sResultText=rs.Fields("name").value
Select Case left(sResultText,2)
Case "c1"
strADsPath="LDAP://cn=" & sResultText & ",cn=computers,dc=contoso,dc=com"
set objou=getobject("LDAP://ou=ouc1,dc=contoso,dc=com")
objou.movehere strADsPath,vbNullString
Case "c2"
strADsPath="LDAP://cn=" & sResultText & ",cn=computers,dc=contoso,dc=com"
set objou=getobject("LDAP://ou=ouc2,dc=contoso,dc=com")
objou.movehere strADsPath,vbNullString
Case "c3"
strADsPath="LDAP://cn=" & sResultText & ",cn=computers,dc=contoso,dc=com"
set objou=getobject("LDAP://ou=ouc3,dc=contoso,dc=com")
objou.movehere strADsPath,vbNullString
Case "c4"
strADsPath="LDAP://cn=" & sResultText & ",cn=computers,dc=contoso,dc=com"
set objou=getobject("LDAP://ou=测试,dc=contoso,dc=com")
objou.movehere strADsPath,vbNullString
End Select
rs.MoveNext
Loop
con.close
然后，在控制面板的“定期任务”中，将此脚本指定多少时间执行一次，然后输入执行的用户和密码，即可。
收工，撤！