企業ではActiveDirectory（ADサーバー）によるユーザー管理を行っているところは多いと思います。
様々なアプリケーションがADサーバーと連携していると思います。
筆者の会社ではネットワークインフラ（LAN・VPN）などと連携しているのですが
半年に一度パスワードを変更しなければならないというポリシーがあります。
Windows7以降は有効期限切れの通知も起動時の一瞬しかでないため
システム担当者はAD連携のシステムが使えない！と呼び出されることになります。
2018年に総務省よりパスワードは変更しないほうがセキュリティが高くなるため変更しないで良いよ、という文章発信がされてます。
一般的にSMS認証やワンタイムパスワード方式の2段階認証のほうがセキュリティは高くなります。
www.soumu.go.jp
ActiveDirectoryを走査して対象者のメールアドレス宛に変更を促すメールを発信するVBScriptを記載しました。
ドメインコントローラー名・SMTPサーバー・ポートを変更の上
ADサーバー上のタスクスケジューラーで動かせば幸せになれるかもしれません。
On Error Resume Next
Const DOMAIN_CONTROLLER = "DOMAIN_NAME" 'ドメインコントローラー名 走査するDCを入力
Const SMTP_AUTH_BASIC = 1 'SMTP認証方式 BASIC認証
Const SMTP_AUTH_NTLM = 2 'SMTP認証方式 NTLM認証
Const SMTP_AUTH_EXCHANGE = 3 'SMTP認証方式 Exchange認証
Const SMTP_SERVER = "smtpserever.domain.local" 'SMTPサーバー名
Const SMTP_PORT = 25 'SMTPサーバーのポート
Const SMTP_FROM = "PASS_CHEACK@domainname.com" '配信者に表示されるメールアドレス（好きな英数字で書換えてください）
Const SMTP_SUBJECT = "Windowsパスワード期限切れ警告メール" '件名
Dim objMail
Set objMail = CreateObject("CDO.Message") 'CDOバインディング
With objMail.Configuration.Fields '設定項目(SMTPスキーマの設定)
objMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = SMTP_AUTH_NTLM
objMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = SMTP_SERVER
objMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = SMTP_PORT
objMail.Configuration.Fields.Update
End With
'ADユーザーデータの取得
'#TODO OU構成の検索（検索ユーザーはDC/Users/Usersの構成に依存している。）例）○ DOMAIN_NAME/Users/Users × DOMAIN_NAME/Users/Users2
Dim objUser
For Each objUser In GetObject("LDAP://ou=users,ou=users,ou=" & DOMAIN_CONTROLLER & ",dc=domain,dc=local") 'dc domain.localは環境に応じて変更ください。
If Not Left(objUser.sAMAccountName,1) = "s" then '共有ユーザーアカウントを除外
If Round(objUser.PasswordLastChanged + 180 - Date, 0) < 15 Then '期限切れ2週間前のアカウントを対象に
If Not Round(objUser.PasswordLastChanged + 180 - Date, 0) < -10 then '消し忘れのアカウントは除外
'メール発信
objMail.From = SMTP_FROM
objMail.to = objUser.mail '配信先のアドレス。
objMail.subject = SMTP_SUBJECT
objMail.textbody = objUser.sn & "様" & vbNewLine & vbNewLine & _
"お疲れ様です。" & vbNewLine & vbNewLine & _
" Windowsのパスワードが" & Round(objUser.PasswordLastChanged + 180 - Date, 0) & _
"日後に有効期限切れとなります。" & vbNewLine & _
"つきましては下記のご対応をよろしくお願い致します。" & vbNewLine & vbNewLine & _
"■ Ctrl+Alt+Deleteを押してパスワードを変更ください。" & vbNewLine & _
"（このメールは社内認証サーバーより自動的に発信しております。）"
objMail.Send '送信
End If
End If
End If
Next
set objUser = Nothing
Set objMail = Nothing
