1.其中exportad.vbs是导出脚本，将活动目录内所有用户导出到一个文本文件(c:\addusers.txt).
2.这个文本每一行代表一个用户，共三个属性，分别为用户的DN，用户Samaccountname，和用户的家庭电话，当中用“%”分隔。
3. Inportad.vbs是导入脚本，用户在修改了导出的文本文件后（比如演示中，修改文本文件的家庭电话一栏），再点击执行这个脚本，即可将修改后的信息写入活动目录。
这两个脚本实现了最核心的内容，即导出-〉修改-〉导入。当然，如果用户需要修改的东西更多，则需要修改这个脚本以满足客户的需要。
============华丽的分割线=========================以下是Export.vbs========================
dim i,wshell,wshNetwork,ntusername,ntuserdomain
Set wshShell = CreateObject("WScript.Shell")
Set wshNetwork = CreateObject("WScript.Network")
Set con = CreateObject("ADODB.Connection")
Set com = CreateObject("ADODB.Command")
'Open the connection with the ADSI-OLEDB provider name
con.Provider = "ADsDSOObject"
con.Open
set objfso = createobject("scripting.filesystemobject")
set objfile = objfso.createtextfile("c:\adusers.txt")
Set objRootDSE = GetObject("")
strADsPath = "LDAP://" & objRootDSE.Get("defaultNamingContext")
Set objDomain = GetObject(strADsPath)
Com.ActiveConnection = con
ntuserdomain=wshNetwork.UserDomain
Com.CommandText = "<"& stradspath &">;" & "(objectCategory=user);SamAccountName,homephone;subTree"
wscript.echo " Your domain is " & stradspath
Set rs = Com.Execute()
i=0
Do Until rs.EOF
if right(rs.Fields("samAccountName"),1)<>"$" Then
ntusername=rs.Fields("samAccountName")
sResultText = sResultText & getuserdn(ntuserdomain,ntusername)& "%" & rs.Fields("SamAccountName") & "%"& rs.Fields("homephone")& vbCrLf
i=i+1
end if
rs.movenext
Loop
WScript.Echo sResultText
objfile.writeline sresulttext
wscript.echo "There are "&i&" users in your domain"
wscript.echo "the output result write to c:\adusers.txt"
con.close
' Constants for the NameTranslate object.
Function getuserdn(domainname,usernamestr)
Const ADS_NAME_INITTYPE_GC = 3
Const ADS_NAME_TYPE_NT4 = 3
Const ADS_NAME_TYPE_1779 = 1
' Specify the NetBIOS name of the domain and the NT name of the user.
strNTName = domainname &"\"& usernamestr
' Use the NameTranslate object to convert the NT user name to the
' Distinguished Name required for the LDAP provider.
Set objTrans = CreateObject("NameTranslate")
' Initialize NameTranslate by locating the Global Catalog.
objTrans.Init ADS_NAME_INITTYPE_GC, ""
' Use the Set method to specify the NT format of the object name.
objTrans.Set ADS_NAME_TYPE_NT4, strNTName
' Use the Get method to retrieve the RPC 1779 Distinguished Name.
strUserDN = objTrans.Get(ADS_NAME_TYPE_1779)
' Escape any "/" characters with backslash escape character.
' All other characters that need to be escaped will be escaped.
strUserDN = Replace(strUserDN, "/", "\/")
getuserdn=strUserDN
End Function
==============再次华丽的分割线==========以下是inport.vbs========================
sub ReadEntireFile(filespec)
Const ForReading = 1
Dim fso, theFile, retstring
Set fso = CreateObject("Scripting.FileSystemObject")
Set theFile = fso.OpenTextFile(filespec, ForReading, False)
Do While thefile.AtEndOfStream <> True
retstring = theFile.ReadLine
splitstring(retstring)
Loop
theFile.Close
ReadEntireFile = retstring
End Sub
Sub splitstring(sptstr)
Dim MyString, MyArray, userdn,usertel
MyString = sptstr
MyArray = Split(MyString, "%", -1, 1)
userdn= "LDAP://" & MyArray(0)
usertel=MyArray(2)
If usertel = "" Then usertel="unknow"
userdnname= userdn
usertelhome=usertel
Call modhometel
End sub
Sub modhometel
Const ADS_PROPERTY_UPDATE = 2
Set objUser = GetObject(userdnname)
objUser.Put "homePhone", usertelhome
objUser.Put "info", "Please do not call this user account" & _
" at home unless there is a work-related emergency. Call" & _
" this user's mobile phone before calling the pager number."
objUser.SetInfo
End Sub
On Error Resume Next
Dim userdnname,usertelhome
Call ReadEntireFile("c:\adusers.txt")
WScript.Echo "AD had already been Inported from c:\aduser.txt file ! "
