Do you know when the user's password expire??

Spanish Version

Goooooooood morning!!!

How can we know in advance if we have a massive password expiration in our organization and to avoid thousands of calls to the Help Desk?

Simple ..:)... I leave you a script that can run a schedule task, it takes the data detailed below:

sAMAccountName
User Last Logon
Password last Set
Password expire
Password expired
Account locked
Maximum Password Age
Days Left
Expiration Date
Account Status
Exchange Server
UserDN
EAS Enabled

Stores them in an Excel spreadsheet, compresses it into a ZIP file and mail it ...funny ha!!
 

Code:



############START SCRIPT ##################################################


Dim connLDAP,serverEx
Dim objCOM
Dim rsLDAP
Dim StrSQL
'Constantes
Const ADS_UF_PASSWD_CANT_CHANGE = &H40
Const ADS_UF_DONT_EXPIRE_PASSWD = &H10000
Const SEC_IN_DAY = 86400
const ADS_UF_ACCOUNTDISABLE = 2
Const FOF_CREATEPROGRESSDLG = &H40&
Const MyZip = "D:\ExpirationDate\PassExpReport.zip"
Set objShell = WScript.CreateObject("WScript.Shell")
Set path = CreateObject("Pathname")
Set fso = CreateObject("Scripting.FileSystemObject")
strSheet = objShell.CurrentDirectory & "\Expiration.xls"
' Initialize Excel
Set objExcel = CreateObject("Excel.Application")
Set objSpread = objExcel.Workbooks.Open(strSheet)
intRow = 2
UserCount=0
strSRCOU = "DC=us,DC=contoso,DC=COM"
strDomain="global.avaya.com"
strDC = "LDAP://DC_NAME." & strDomain & "/"  
strBase =  strDC & strSRCOU
oDC="DC_NAME.us.contoso.com"

Set objFileSystem = CreateObject ("Scripting.FileSystemObject")
Set ConnLDAP = CreateObject("ADODB.connection")
Set objCOM = CreateObject("ADODB.Command")
connLDAP.Provider = "ADsDSOObject"
connLDAP.Open
   
objCOM.ActiveConnection = connLDAP
objCOM.Properties("searchscope") = 2
objCOM.Properties("Chase referrals") = 64
objCOM.Properties("Cache Results") = False

StrSQL = "SELECT name,distinguishedName FROM '" & strBase & "' where  objectCategory='organizationalUnit' AND objectClass='organizationalUnit' OR objectClass='Container' AND name='Users'  "

objCOM.CommandText = StrSQL
Set rsLDAP = objCOM.Execute
While Not rsLDAP.EOF
filtro = rsLDAP(0)
if instr(filtro,"OU=All Users") <> 0 then
 
 call connect(filtro)
end if
rsLDAP.MoveNext
Wend

sub connect(nombre)
on error resume next
binding=strDC & nombre
set Ad = GetObject(Binding)
for each x in Ad
    if x.class = "user" then
     strUserDN = replace(x.distinguishedName, "/", "\/")
     objExcel.Cells(intRow, 1)=ucase(x.samaccountname)
     strWirelessEnabled = x.msExchOmaAdminWirelessEnable
     strWirelessEnabled2K7 = x.msExchMobileMailboxFlags
     statusAcc=x.userAccountControl
     oHMDB=isnull(x.homeMDB )
     serverEx=""
     if  not oHMDB then
      strHomeMDB= split(x.homeMDB,",")
      serverEx=right(trim(replace(replace(strHomeMDB(0),")",""),"(","")),11)
      if instr(strHomeMDB(0), "Server1") = 0 then
    if instr(strHomeMDB(0), "ServerExch2k7") = 0 then
     serverEx=right(trim(replace(replace(strHomeMDB(0),")",""),"(","")),11)
    else
     serverEx=left(right(trim(replace(replace(strHomeMDB(0),")",""),"(","")),19),11)
    end if
      else
    serverEx=right(trim(replace(replace(strHomeMDB(0),")",""),"(","")),9)
      end if
    
     else
      serverEx="No Mailbox"
     end if
     objExcel.Cells(intRow,11) = serverEx
     objExcel.Cells(intRow,12) = strUserDN
    
     if strWirelessEnabled=0 or strWirelessEnabled2K7= 1 then
    
      objExcel.Cells(intRow,13) = "Enabled"
     else
      objExcel.Cells(intRow,13) = "Disabled"
     end if
    
    
     wscript.echo "Exchange server :" & serverEx
    
     if statusAcc and ADS_UF_ACCOUNTDISABLE then
   ostatus= "Disabled"

     else
   ostatus= "Enabled"

     end if
    
     objExcel.Cells(intRow,10) = ostatus
     wscript.echo "Account status :" & ostatus
    
     wscript.echo passSetF (strUserDN,oDC,strDomain)
     intRow = intRow + 1
    end if
  
next
end sub

intRow = intRow - 3
wscript.Echo ""
wscript.Echo intRow & " users found in domain"
wscript.Echo "End time:  " & now


objSpread.Save
objSpread.Close
objExcel.Quit
'zip report

'-- create empty zip file
'Create the basis of a zip file.
CreateObject("Scripting.FileSystemObject") _
.CreateTextFile(MyZip, True) _
.Write "PK" & Chr(5) & Chr(6) & String(18, vbNullChar)

'-- zip
'get ready to add files to zip
set objShell=CreateObject("Shell.Application")
objShell.NameSpace(MyZip).CopyHere strSheet, FOF_CREATEPROGRESSDLG
wScript.Sleep 6000
call sendReport

wscript.quit
'============================================================================================

sub sendReport()
Dim iMsg
Dim iConf
Dim Flds
Dim strHTML
Const cdoSendUsingPort = 2
set iMsg = CreateObject("CDO.Message")
set iConf = CreateObject("CDO.Configuration")
Set Flds = iConf.Fields

With Flds
    .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = cdoSendUsingPort
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "mailhost.contoso.com"
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 20000
    .Update
End With

With iMsg
     Set .Configuration = iConf
    .To = "grupodesoporte@contoso.com"
    .From = "reportes@contoso.com"
    .Subject ="Contoso- Daily user's password expiration Report."
    .TextBody = "This email has been automatically created to get the Contoso domain user's password expiration report"
    .AddAttachment MyZip
    .Send

End With
if err.number =0 then
  wscript.echo "The email was sent to " & strTo & " successfully."
else
  wscript.echo "The email wasn't sent to " & strTo & "with the error" & err.description & " ."
end if


Set iMsg = Nothing
Set iConf = Nothing
Set Flds = Nothing
end sub
function passSetF(strUserDN,oDC,oDomain)
Set objUser = GetObject("LDAP://" & oDC & "/" & strUserDN)
Set objDomainNT = GetObject("WinNT://" & odomain)
intMaxPwdAge = objDomainNT.Get("MaxPasswordAge")
intMaxPwdAge = (intMaxPwdAge/SEC_IN_DAY)
wscript.echo "Maximum Password Age: " & intMaxPwdAge
objExcel.Cells(intRow, 7) = intMaxPwdAge
wscript.echo "Account locked: " & objUser.IsAccountLocked
objExcel.Cells(intRow, 6) = objUser.IsAccountLocked
' Retrieve user password information.
Set objDate = objUser.PwdLastSet
dtmPwdLastSet = Integer8Date(objDate, lngBias)
lngFlag = objUser.Get("userAccountControl")

blnPwdExpire = True
If ((lngFlag And ADS_UF_PASSWD_CANT_CHANGE) <> 0) Then
    blnPwdExpire = False
End If
If ((lngFlag And ADS_UF_DONT_EXPIRE_PASSWD) <> 0) Then
    blnPwdExpire = False
End If
' Determine if password expired.
blnExpired = False
If (blnPwdExpire = True) Then
    If (DateDiff("d", dtmPwdLastSet, Now) > intMaxPwdAge) Then
        blnExpired = True
    else
    wscript.echo "Expiration date :" & datevalue(intMaxPwdAge + dtmPwdLastSet )
    wscript.echo "Days left : " &  int((intMaxPwdAge + dtmPwdLastSet ) - now)
    objExcel.Cells(intRow, 8) = int((intMaxPwdAge + dtmPwdLastSet ) - now)
    objExcel.Cells(intRow, 9) = datevalue(intMaxPwdAge + dtmPwdLastSet )
    End If
End If
ologon=objUser.LogonCount
'wscript.echo ologon
if ologon <> 0 then
Set objDate2 = objUser.lastLogonTimeStamp
on error resume next
If err.number <> 0 then

 dtmDate2 = #1/1/1601#
 err.clear
Else
 On Error resume next

 lngHigh = objDate2.HighPart
 lngLow = objDate2.LowPart
 If (lngLow < 0) Then
      lngHigh = lngHigh + 1
 End If
 If (lngHigh = 0) And (lngLow = 0) Then
      dtmDate2 = #1/1/1601#
 Else
      dtmDate2 = #1/1/1601# + (((lngHigh * (2 ^ 32)) _
  + lngLow)/600000000 - lngBias)/1440
 End If
End If
' Display values for the user.
If (dtmDate2 = #1/1/1601#) Then
 
 objExcel.Cells(intRow, 2) = "Never"
 wscript.echo "User Last Logon :Never"
Else
 objExcel.Cells(intRow, 2) = dtmDate2
 wscript.echo "User Last Logon : " & dtmDate2

End If
else
 objExcel.Cells(intRow, 2) = "Never"
 wscript.echo "User Last Logon :Never"
end if

 objExcel.Cells(intRow, 3) = dtmPwdLastSet
wscript.echo "Password last Set : " & dtmPwdLastSet

wscript.echo  "Password expire : " & blnPwdExpire
objExcel.Cells(intRow, 4) = blnPwdExpire
wscript.echo  "Password expired : " & blnExpired
objExcel.Cells(intRow, 5) = blnExpired
' Clean up.
Set objUser = Nothing
Set objShell = Nothing
Set objRootDSE = Nothing
Set objDomain = Nothing
Set objMaxPwdAge = Nothing
Set objDate = Nothing

end function
function Integer8Date( objDate, lngBias)
    ' Function to convert Integer8 (64-bit) value to a date, adjusted for
    ' local time zone bias.
    Dim lngAdjust, lngDate, lngHigh, lngLow
    lngAdjust = lngBias
    lngHigh = objDate.HighPart
    lngLow = objdate.LowPart
    ' Account for bug in IADslargeInteger property methods.
    If (lngLow < 0) Then
        lngHigh = lngHigh + 1
    End If
    If (lngHigh = 0) And (lngLow = 0) Then
        lngAdjust = 0
    End If
    lngDate = #1/1/1601# + (((lngHigh * (2 ^ 32)) _
        + lngLow) / 600000000 - lngAdjust) / 1440
    Integer8Date = CDate(lngDate)
End function




############END SCRIPT######################################################

I hope this will be usefull, please let me your comments
-Dario