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