【VBScript】ActiveDirectoryのパスワード期限が来た時にメールで通知

ADの特定ユーザーのパスワードが有効期限まで3日に迫った場合に、特定のアドレスにアラートメールを送信したい・・という要望があったので、スクリプトをVBSで適当に作ってみました。
ADメンバーサーバー上のタスクで、1日1回実行するよう設定しています。

【参考】

Option Explicit

Dim objUser
Dim intUserAccountControl
Dim dtmValue
Dim intTimeInterval
Dim objDomain
Dim objMaxPwdAge
Dim dblMaxPwdNano
Dim dblMaxPwdSecs
Dim dblMaxPwdDays
Dim objSysInfo
Dim oMsg
Set objSysInfo = CreateObject(“ADSystemInfo”)

Const ADS_UF_DONT_EXPIRE_PASSWD = &h10000
Const E_ADS_PROPERTY_NOT_FOUND = &h8000500D
Const ONE_HUNDRED_NANOSECOND = .000000100
Const SECONDS_IN_DAY = 86400

Set objUser = GetObject(“LDAP://cn=hogehoge_user,cn=Users,dc=hogehoge,dc=local”)

‘##### パスワード有効期限有無の確認 #####
intUserAccountControl = objUser.Get(“userAccountControl”)
If intUserAccountControl And ADS_UF_DONT_EXPIRE_PASSWD Then
WScript.Quit
Else
dtmValue = objUser.PasswordLastChanged
intTimeInterval = Int(Now – dtmValue)

Set objDomain = GetObject(“LDAP://DC=hogehoge,DC=local”)
Set objMaxPwdAge = objDomain.Get(“maxPwdAge”)

‘##### パスワード有効期限確認 #####
If objMaxPwdAge.LowPart = 0 Then
WScript.Quit
Else
dblMaxPwdNano = _
Abs(objMaxPwdAge.HighPart * 2^32 + objMaxPwdAge.LowPart)
dblMaxPwdSecs = dblMaxPwdNano * ONE_HUNDRED_NANOSECOND
dblMaxPwdDays = Int(dblMaxPwdSecs / SECONDS_IN_DAY)

‘##### パスワード期限切れの確認 #####
If intTimeInterval >= dblMaxPwdDays Then
WScript.quit
ElseIf Int((dtmValue + dblMaxPwdDays) – Now) ”
oMsg.To = “”
oMsg.Cc = “”
oMsg.Subject = “パスワード期限3日前です”
oMsg.TextBody = “ユーザーhogehoge_userのパスワード有効期限まであと ” & _
Int((dtmValue + dblMaxPwdDays) – Now) & ” 日です！ 変更して下さい！”
oMsg.Configuration.Fields.Item _
(“http://schemas.microsoft.com/cdo/configuration/sendusing”) = 2
oMsg.Configuration.Fields.Item _
(“http://schemas.microsoft.com/cdo/configuration/smtpserver”) = _
“”
oMsg.Configuration.Fields.Item _
(“http://schemas.microsoft.com/cdo/configuration/smtpserverport”) = 25
oMsg.Configuration.Fields.Update
oMsg.Send
Else
WScript.quit
End If
End If
End If