工作需要从Excel文件中批量导入用户的职位，部门，电话和手机等信息到AD用户（在Outlook或者Lync中显示），Google了半天搞了这个VBS脚本。

使用时需要建立useinfo.csv文件，每行内容依次为AD用户的Display Name（全名），职位，部门，电话，手机，所属公司。假如域名为ABC.local，需要处理的OU为testOU；userinfo.csv同目录，脚本内容如下：

Dim userInfo
Dim userCounter
Const ADS_SCOPE_SUBTREE = 2

Set fso = CreateObject("Scripting.FileSystemObject")
Set objFile = fso.OpenTextFile("Userinfo.csv")

Set objConnection = CreateObject("ADODB.Connection")
Set objCommand =   CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
userCounter = 0
Do
On Error Resume Next
        userInfo = Split(objfile.ReadLine,",")
        strDN = FindUserDN(userInfo(0))
        Set objUser = GetObject("LDAP://" & strDN)
        objUser.Put "title", userInfo(1)
        objUser.Put "department", userInfo(2)
        objUser.Put "telephoneNumber", userInfo(3)
        objUser.Put "mobile", userInfo(4)
        objUser.Put "company", userInfo(5)
        objUser.SetInfo       
        userCounter = userCounter + 1
        If Err.Number <> 0 Then
               userCounter = userCounter -1
               WScript.Echo "Failed user:  " & userInfo(0) 
        End If
        strDN = ""
Loop Until objfile.AtEndOfStream = True

objfile.Close

WScript.Echo "A total of " & UserCounter & " users' infomation has been updated."

Function FindUserDN(strUserDisplayName)
        objCommand.CommandText = _
            "SELECT distinguishedName FROM 'LDAP://OU=testOU,DC=ABC,DC=Local' WHERE objectCategory='user' " & _
                "AND displayname = '" & strUserDisplayName & "'"
        Set objRecordSet = objCommand.Execute
        objRecordSet.MoveFirst
        Do Until objRecordSet.EOF
            arrDN = objRecordSet.Fields("distinguishedName").Value
            If IsArray(arrDN) = True Then
                    WScript.Echo strUserDisplayName
                    FindUserDN = arrDN(0)
            Else
                    FindUserDN = arrDN
            End if
            objRecordSet.MoveNext
        Loop
        If Err.Number <> 0 Then
                WScript.Echo Err.Description & ":" & strUserDisplayName
                Err.Clear
        End If       
End Function