VBScript: A script that offers to change the password for an Active Directory user the required number of days before its expiration

This script is best executed by Group Policy when a user logs on to an Active Directory domain. By setting up the "warningDays" parameter, you can adjust the number of days before the password expires, and in this interval the script will prompt a user to change his password to a new one.

Function SessionId
    Dim oShell, sCmd, oWMI, oChldPrcs, oCols, lOut
    lOut = 0
    Set oShell  = CreateObject("WScript.Shell")
    Set oWMI    = GetObject(_
        "winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
    sCmd = "/K " & Left(CreateObject("Scriptlet.TypeLib").Guid, 38)
    oShell.Run "%comspec% " & sCmd, 0
    WScript.Sleep 100
    Set oChldPrcs = oWMI.ExecQuery(_
        "Select * From Win32_Process Where CommandLine Like '%" & sCmd & "'",,32)
    For Each oCols In oChldPrcs
        lOut = oCols.SessionId
        oCols.Terminate
        Exit For
    Next
    SessionId = lOut
End Function

Function getOSVersion(strComputerName)
	Set objWMI = GetObject("winmgmts://" & strComputerName & "/root/cimv2")
	Set colItems = objWMI.ExecQuery("Select * from Win32_OperatingSystem",,48)
	For Each objItem In colItems
		strOSVersion = left(objItem.Version, 2)
	Next
	getOSVersion = strOSVersion
End Function

Dim oDomain
Dim oUser
Dim maxPwdAge
Dim numDays
Dim intAnswer
Dim intUserAccountControl
Dim boolUserAccountControl
Dim warningDays
Dim strComputerName
Dim strOSVersion
Const ADS_UF_DONT_EXPIRE_PASSWD = &h10000
'==============================================================================
' Number of days before account expiration to start the warning message.
warningDays = 7
'==============================================================================
strComputerName = "."
strOSVersion = getOSVersion(strComputerName)
If (strOSVersion = "10") Or (strOSVersion = "6.") = True Then
	Set LoginInfo = CreateObject("ADSystemInfo")
	Set objUser = GetObject("LDAP://" & LoginInfo.UserName & "")
	strDomainDN = UCase(LoginInfo.DomainDNSName)
	strUserDN = LoginInfo.UserName
	intUserAccountControl = objUser.Get("userAccountControl")
	If intUserAccountControl And ADS_UF_DONT_EXPIRE_PASSWD Then
		boolUserAccountControl = 0
	Else
		boolUserAccountControl = 1
	End If
	Set oDomain = GetObject("LDAP://" & strDomainDN)
	Set maxPwdAge = oDomain.Get("maxPwdAge")
	numDays = CCur((maxPwdAge.HighPart * 2 ^ 32) + _
	maxPwdAge.LowPart) / CCur(-864000000000)
	Set oUser = GetObject("LDAP://" & strUserDN)
	whenPasswordExpires = DateAdd("d", numDays, oUser.PasswordLastChanged)
	fromDate = Date
	daysLeft = DateDiff("d",fromDate,whenPasswordExpires)
	If (daysLeft < (warningDays + 1)) And (daysLeft > -1) And (boolUserAccountControl = 1) = True Then
		Set oShell = CreateObject( "WScript.Shell" )
		sessionName = LCase(oShell.RegRead("HKCU\Volatile Environment\" &SessionId& "\SESSIONNAME"))
		If ( sessionName = "console" ) Then 
			MsgBox "Your password will expire in " & daysleft _
			& " days on " & whenPasswordExpires _
			& ". To change your password, press CTRL+ALT+DELETE and then click ""Change a password..."".", _
			vbExclamation, "Logon Message"
		Else
			intAnswer = MsgBox("Your password will expire in " & daysleft _
			& " days on " & whenPasswordExpires & ". Do you want to change it now?", _
			vbExclamation + vbYesNo, "Logon Message")
			If intAnswer = vbYes Then
				oShell.Run "explorer.exe shell:::{2559a1f2-21d7-11d4-bdaf-00c04f60b9f0}"
			End If
		End If 
	End If
End If