VBscript: Identify Accounts that are set to "Password Never Expires" in AD

Hi Experts,

   I'm curious if you have or know of a script that will search users in AD (enumerating them in the process) and identify all accounts that are set to "Password Never Expires."   After the script has identified the accounts in question, It would be nice if I could if the script exported those results say to an Excel spreadsheet.  

Thanks a million!
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.


This is the answer to the same question you have.  I have attached the "accepted solution in case you don't have access.

Part of the reports of ManageEngine ADManager Plus is "AD User Reports"


You can download the free version from here:


It will do the job for you.



Open in new window

itsmevicAuthor Commented:
Hi SR,

   Great suggestions!  I've looked at them.   I was looking more into an actual vb script that would do this and export it to a CSV file.  If I can avoid it, I'd rather not download third party software for reasons beyond my control.
itsmevicAuthor Commented:
Was doing a bit of research and came across the below script/macro that I can use in Excel.  Very cool stuff, however it's bombing out on me when I try and execute it and I know it's something simple, I'm just missing it. This provides everything I'd with the exception of the employee ID as I would not need that.
Const ONE_HUNDRED_NANOSECOND = 0.0000001    ' .000000100 is equal to 10^-7
Const SECONDS_IN_DAY = 86400
Sub UserAccounts_AD_Users()
    EnumUsersInOU ("OU=Users,")
End Sub
Sub EnumUsersInOU(strOU)
'strOU = "" 'Add trailing comma if not blank.  i.e.  strOU = "OU=Users,"
    Set objShell = CreateObject("WScript.Shell")
    Dim SkipRecord As Boolean
    strLDAP = "(&(objectcategory=person)(objectclass=user))"
    Set oRootDSE = GetObject("LDAP://RootDSE")
    strDomainNC = oRootDSE.Get("defaultNamingContext")
    Set oRootDSE = Nothing
    Set oConnection = CreateObject("ADODB.Connection")
    oConnection.Provider = "ADsDSOObject"
    oConnection.Open "Active Directory Provider"
    Set oCommand = CreateObject("ADODB.Command")
    Set oCommand.ActiveConnection = oConnection
    strAttributes = "sAMAccountName,givenname,sn,displayname,employeeid,distinguishedname"
    strQuery = "<LDAP://" & strOU & strDomainNC & ">;" & strLDAP & ";" & strAttributes & ";subtree"
    Set oDomain = GetObject("LDAP://" & strDomainNC)
    oCommand.CommandText = strQuery
    oCommand.Properties("Page Size") = 1000
    Set orecordset = oCommand.Execute
    Set maxPwdAge = oDomain.Get("maxPwdAge")
'    numDays = ((maxPwdAge.HighPart * 2 ^ 32) + _
'               maxPwdAge.LowPart) / -864000000000@
    If maxPwdAge.LowPart = 0 Then
        MsgBox "The Maximum Password Age is set to 0 in the " & _
            "domain. Therefore, the password does not expire."
        dblMaxPwdNano = Abs(maxPwdAge.HighPart * 2 ^ 32 + maxPwdAge.LowPart)
        dblMaxPwdSecs = dblMaxPwdNano * ONE_HUNDRED_NANOSECOND   ' LINE 13
        dblMaxPwdDays = Int(dblMaxPwdSecs / SECONDS_IN_DAY)      ' LINE 14
        numDays = dblMaxPwdDays
        'WScript.Echo "Maximum password age: " & dblMaxPwdDays & " days"
    End If
    'Clear Worksheet - optional
    With Range("A1:G1")
        .Value = Array("UserID", "First Name", "Last Name", "Display Name", "EmployeeID", "Password Expiry", "Blank Password")
        .Font.Bold = True
        .Font.Size = 12
    End With
    Application.ScreenUpdating = False
    y = 2
    If Not orecordset.EOF Then
        While Not orecordset.EOF
            SkipRecord = False
            ActiveSheet.Cells(y, 1).Value = orecordset.Fields(0)
            ActiveSheet.Cells(y, 2).Value = orecordset.Fields(1)
            ActiveSheet.Cells(y, 3).Value = orecordset.Fields(2)
            ActiveSheet.Cells(y, 4).Value = orecordset.Fields(3)
            ActiveSheet.Cells(y, 5).Value = orecordset.Fields(4)
            On Error Resume Next
            'Set objuser = GetObject("LDAP://" & orecordset.Fields(5))
            Set objuser = GetObject("LDAP://" & Replace(orecordset.Fields(5), "/", "\/"))
            If Err.Number <> 0 Then
                MsgBox "Error binding to " & orecordset.Fields(5)
                SkipRecord = True
            End If
            On Error GoTo 0
            If SkipRecord = False Then
                intUserAccountControl = objuser.Get("userAccountControl")
                On Error Resume Next
                dtmValue = objuser.PasswordLastChanged
                If Err.Number = E_ADS_PROPERTY_NOT_FOUND Then
                    ActiveSheet.Cells(y, 6) = "NO PASSWORD SET"
                    On Error GoTo 0
                    On Error GoTo 0
                    If intUserAccountControl And ADS_UF_DONT_EXPIRE_PASSWD Then
                        ActiveSheet.Cells(y, 6) = "NON-EXPIRING PASSWORD"
                        whenPasswordExpires = DateAdd("d", numDays, objuser.PasswordLastChanged)
                        If whenPasswordExpires < Now() Then
                            ActiveSheet.Cells(y, 6) = "expired"
                            ActiveSheet.Cells(y, 6) = whenPasswordExpires
                        End If
                    End If
                End If
                strDomain = objShell.ExpandEnvironmentStrings("%USERDOMAIN%")
                strCommand = """" & strPSExec & """ -accepteula -e -u " & strDomain & "\" & orecordset.Fields(0) & " -p """" cmd /c echo hi"
                intReturn = objShell.Run(strCommand, 0, True)
                If intReturn = 1326 Then
                    ActiveSheet.Cells(y, 7) = "No"
                    ActiveSheet.Cells(y, 7) = "Yes"
                End If
                ActiveSheet.Cells(y, 6) = "UNABLE TO BIND"
            End If
            y = y + 1
    End If
    Application.ScreenUpdating = True
End Sub

Open in new window

Simplify Active Directory Administration

Administration of Active Directory does not have to be hard.  Too often what should be a simple task is made more difficult than it needs to be.The solution?  Hyena from SystemTools Software.  With ease-of-use as well as powerful importing and bulk updating capabilities.

Mike KlineCommented:
Does it have to be in vbscript?  You can use a tool like adfind and get this in one line

adfind -default -bit -f "&(objectCategory=person)(objectClass=user)(userAccountControl:AND:=65536)" samaccountname givenname sn displayname employeeid -csv > C:\usersPWneverExpire.csv



Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
itsmevicAuthor Commented:
That did it, thanks MK.  
itsmevicAuthor Commented:
Worked great, thank you!
Mike KlineCommented:
Excellent glad to help.

It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
VB Script

From novice to tech pro — start learning today.