VBS处理AD帐号密码到期提醒的脚本[zt]

原文：https://gallery.technet.microsoft.com/scriptcenter/f7f5f7ed-14ee-4d0e-81c2-7d95ce7e08f5

'==========================================================================
'Milan on 1/12/2011
’ This script can be used to notify users of when their windows passords
’ are going to expire. Especially useful in those cases where user does not logon
’ to windows with individual login and uses OWA for email
’ Script is currently running fine in a Exchange 2010 env with AD 2008
'==========================================================================
On Error Resume Next
Const ADS_SCOPE_SUBTREE = 2
Const SEC_IN_DAY = 86400
Const ADS_UF_DONT_EXPIRE_PASSWD = &h10000 ’ tocheck for accounts that have “no expire” set on the password

Dim maxPwdAge
maxpwdage = 90 'set this according to policy in your organization
Dim numDays
Dim warningDays
warningDays = 14 ’ set this according to policy in your organization

'ADO to access Active Directory
Set objConnection = CreateObject(“ADODB.Connection”)
Set objCommand = CreateObject(“ADODB.Command”)
objConnection.Provider = “ADsDSOObject”
objConnection.Open “Active Directory Provider”
Set objCommand.ActiveConnection = objConnection
Set objRootDSE = GetObject(“LDAP://rootDSE”)

DomainString = objRootDSE.Get(“dnsHostName”)

objCommand.Properties(“Page Size”) = 1000
objCommand.Properties(“Searchscope”) = ADS_SCOPE_SUBTREE

objCommand.CommandText = “SELECT DisplayName,mail,DistinguishedName,sAMAccountName FROM ‘LDAP://OU=xxxx,DC=abcdefg,DC=com,DC=cn’” & _
" where objectClass=‘user’"
'" WHERE objectCategory=‘user’" 'This was creating problems where it was picking up two objects that were contacts, not users
Set objRecordSet = objCommand.Execute

objRecordSet.MoveFirst 'get to the first record in the recordset
Do Until objRecordSet.EOF
strUser = objRecordSet.Fields(“sAMAccountName”).Value
strDN = objRecordSet.Fields(“DistinguishedName”).Value 'This is important otherwise we cannot pull the "last Password Change date
strMail = objRecordSet.Fields(“mail”).Value
strFullName = objRecordSet.Fields(“DisplayName”).Value

    For Each objItem in strUser  'one record at a time  
        Set objUserLDAP = GetObject ("LDAP://" & strDN & "")  
        intCurrentValue = objUserLDAP.Get("userAccountControl") ' For checking if the account is disabled  
          
        '*******************************************************************************************  
        'BEGIN OF PASSWORD EXPIRATION WARNING  
        '*******************************************************************************************  

            numDays = maxpwdage  
            dtVal = objUserLDAP.PasswordLastChanged 'The latest date the user changed her/his password  
            whenPasswordExpires = DateAdd("d", numDays, dtval)  
            fromDate = Date
            daysLeft = DateDiff("d",fromDate,whenPasswordExpires)  
            If (daysLeft < warningDays) and (daysLeft > 0) then  'If 14 days or less remain until Password expires  
                wscript.echo strFullname & "(" & strUser & "), 您的办公网域帐号将于 " & daysLeft & "天后到期。请尽快修改以免影响网络使用。" & vbcrlf
            End if  
    Next
objRecordSet.MoveNext ' Keep going down the table  

Loop

Set objConnection = Nothing
Set objCommand = Nothing
Set objCommand.ActiveConnection = Nothing
Set objRootDSE = Nothing
Set objRecordSet = Nothing
Set objUserLDAP = Nothing
Set objEmail = Nothing
WScript.Quit