檢查 AD 中已到期帳號

一般實務上來說, 在帳號到期前應該把到期日設定上去
等帳號實際到期後再將帳號停用並搬到專門放到期帳號的 OU 中

但這麼多帳號往往會忘記到底哪些帳號是到期的
本 VBScript 程式可以將已到期帳號找出並發信通知後續動作

收信人 Email 如果有多位應該要設定 Group Mail
所以本程式不寫成可寄發給多人

===== 程式開始 =====

' LDAP 查詢範圍, 此處輸入 DN
LDAPScope = "CN=Users,DC=contoso,DC=com"

' 發信人 Email
EmailFrom = "Administrator@contoso.com"

' 收信人 Email
EmailTo = "MIS@contoso.com"

'--------------------------------------------------------
Const ForWriting = 2
On Error Resume Next
Const ADS_SCOPE_SUBTREE = 2
SearchScope = "LDAP://" & LDAPScope
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand =   CreateObject("ADODB.Command")
Set objCommand.ActiveConnection = objConnection
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
objCommand.CommandText = "SELECT ADsPath FROM '" & SearchScope & "' WHERE objectCategory='person'"
SearchContent=""
Set objRecordSet = objCommand.Execute
objRecordSet.MoveFirst
Do Until objRecordSet.EOF
     ldap_path=objRecordSet.Fields("ADsPath").Value
     Set objUser=GetObject(ldap_path)
 IF objUser.AccountExpirationDate <> "1970/1/1" and objUser.AccountExpirationDate > "2000/1/1" and objUser.AccountExpirationDate < Now Then
  SearchContent = SearchContent & "使用者:" & objUser.DisplayName & vbTab
  SearchContent = SearchContent & "帳戶到期日: " & DateAdd("d",-1,objUser.AccountExpirationDate) & vbTab
  SearchContent = SearchContent & ldap_path & vbcrlf
 End IF
     objRecordSet.MoveNext
Loop
if SearchContent <> "" Then
 Set objEmail = CreateObject("CDO.Message")
 objEmail.From = EmailFrom
 objEmail.To = EmailTo
 objEmail.Subject = "AD 帳號到期待刪除通知 (" & NOW & ")"
 objEmail.Textbody = "AD 帳號到期待刪除通知 (" & NOW & ") " & vbcrlf & vbcrlf & "搜尋範圍: " & SearchScope & vbcrlf & vbcrlf & SearchContent
 objEmail.Configuration.Fields.Item  ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
 objEmail.Configuration.Fields.Item  ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "mail.contoso.com.tw"
 objEmail.Configuration.Fields.Item  ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
 objEmail.Configuration.Fields.Update
 objEmail.Send
 Set objEmail = nothing
end if