'CONST ForReading = 1
CONST ForWriting = 2
CONST ForAppending = 8
CONST CONST_ERROR = 0
CONST CONST_WSCRIPT = 1
CONST CONST_CSCRIPT = 2
CONST CONST_SHOW_USAGE = 3
CONST CONST_LIST = 4
Const ADS_SCOPE_SUBTREE = 2
Const ADS_UF_DONT_EXPIRE_PASSWD = 65536
Const ADS_UF_PASSWORD_EXPIRED = 8388608
Const E_ADS_PROPERTY_NOT_FOUND = &h8000500D
Const ONE_HUNDRED_NANOSECOND = .000000100
Const SECONDS_IN_DAY = 86400
Dim lastLogin
'''''''''''''''''''''''''
Set objShell = CreateObject("Wscript.Shell")
lngBiasKey = objShell.RegRead("HKLM\System\CurrentControlSet\Control\" _
& "TimeZoneInformation\ActiveTimeBias")
If (UCase(TypeName(lngBiasKey)) = "LONG") Then
lngBias = lngBiasKey
ElseIf (UCase(TypeName(lngBiasKey)) = "VARIANT()") Then
lngBias = 0
For k = 0 To UBound(lngBiasKey)
lngBias = lngBias + (lngBiasKey(k) * 256^k)
Next
End If
Set objShell = Nothing
'''''''''''''''''''''''''
inputOU=inputbox("请输入查询的OU,该OU必须位于" & TARGET_OU & "的下一层,不输入为查询此OU下所有帐号","输入信息")
Outputfile= strDCName1 & "账号列表" & inputOU
Set FSO = CreateObject("Scripting.FileSystemObject")
Set fLog = fso.OpenTextFile(Outputfile & ".csv", ForWriting,TRUE)
fLog.WriteLine "帐号,姓名,工号,公司,部门,最后登陆时间,是否有邮箱,是否停用"
Set rootDSE = GetObject("LDAP://rootDSE")
BaseDN = rootDSE.Get("defaultNamingContext")
DC= replace(BaseDN,"DC=",",")
DC= replace(DC,",,",".")
DC=right(DC,len(DC)-1)
TARGET_OU = "Employee"
if inputOU<>"" then
TARGET_OU=inputOU & ",OU=" & TARGET_OU
end if
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand = CreateObject("ADODB.Command")
Set objCommand.ActiveConnection = objConnection
Set objCommand1 = CreateObject("ADODB.Command")
Set objCommand1.ActiveConnection = objConnection
'on error resume next
objCommand.CommandText = "
;(&(objectclass=organizationalUnit));cn,ADsPath;subtree"
Set objRecordSet = objCommand.Execute
if err.number<>0 then
msgbox "无法找到:" & TARGET_OU
end if
wscript.echo "Begin:"
If objRecordSet.RecordCount>0 Then
i = 0
Set OU = GetObject(objRecordSet.Fields("ADsPath").Value)
OUdistinguishedName=OU.distinguishedName
Wscript.Echo OUdistinguishedName
Set adoCommand = CreateObject("ADODB.Command")
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
adoCommand.ActiveConnection = adoConnection
strBase = ""
' Filter on all user objects.
strFilter = "(&(objectCategory=person)(objectClass=user))"
' Comma delimited list of attribute values to retrieve.
strAttributes = "distinguishedName,ADsPath,lastLogonTimeStamp" & ";subtree"
' Construct the LDAP syntax query.
strQuery = strBase & ";" & strFilter & ";" & strAttributes
' Run the query.
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 10000
adoCommand.Properties("Timeout") = 60
adoCommand.Properties("Cache Results") = False
Set adoRecordset = adoCommand.Execute
' Enumerate resulting recordset.
adoRecordset.movefirst
Do Until adoRecordset.EOF
On Error Resume Next
adspath=adoRecordset.Fields("adspath")
ShowMSG adspath
Set objMailbox = GetObject(adspath)
lastName=objMailbox.sn
If(objMailbox.legacyExchangeDN="") Then
mailaddress="无邮箱"
Else
mailaddress=objMailbox.mail
End If
statusflag=objMailbox.AccountDisabled
firstName=objmailbox.givenname
mailNickname=objMailbox.samaccountname
company=objMailbox.company
department=objMailbox.department
Set objDate = adoRecordset.Fields("lastLogonTimeStamp").Value
If (Err.Number <> 0) Then
On Error GoTo 0
dtmDate = #1/1/1601#
Else
On Error GoTo 0
lngHigh = objDate.HighPart
lngLow = objDate.LowPart
If (lngLow < 0) Then
lngHigh = lngHigh + 1
End If
If (lngHigh = 0) And (lngLow = 0 ) Then
dtmDate = #1/1/1601#
Else
dtmDate = #1/1/1601# + (((lngHigh * (2 ^ 32)) _
+ lngLow)/600000000 - lngBias)/1440
End If
End If
lastLogin=dtmDate
fLog.WriteLine mailNickname & "," & lastName & "," & firstName & "," & company & "," & department & "," & lastLogin & "," & mailaddress & "," & statusflag
adoRecordset.MoveNext
i=i+1
Loop
End If
wscript.echo "总计输出账号为:" & i
Sub ShowMSG(strSubMSG)
Wscript.Echo Time & vbTab & strSubMSG
end sub
set adoRecordset=nothing
set adoCommand=nothing
adoConnection.close
set adoConnection=nothing
