企業では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