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!
itsmevicAsked:
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.

sr75Commented:
http://www.experts-exchange.com/Networking/Misc/Q_21889838.htmlhttp://www.experts-exchange.com/Networking/Misc/Q_21889838.html

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"

http://manageengine.adventnet.com/products/ad-manager/active_directory_user_reports.html

You can download the free version from here:

http://www.manageengine.com/products/ad-manager/download.html?free

It will do the job for you.

HTH.

Naser

Open in new window

0
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.
0
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 ADS_UF_DONT_EXPIRE_PASSWD = &H10000
Const E_ADS_PROPERTY_NOT_FOUND = &H8000500D
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."
    Else
        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
    ActiveSheet.Cells.ClearContents
 
    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
            Err.Clear
            '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
                Err.Clear
            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"
                    Err.Clear
                    On Error GoTo 0
                Else
                    On Error GoTo 0
                    If intUserAccountControl And ADS_UF_DONT_EXPIRE_PASSWD Then
                        ActiveSheet.Cells(y, 6) = "NON-EXPIRING PASSWORD"
                    Else
                        whenPasswordExpires = DateAdd("d", numDays, objuser.PasswordLastChanged)
                        If whenPasswordExpires < Now() Then
                            ActiveSheet.Cells(y, 6) = "expired"
                        Else
                            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"
                Else
                    ActiveSheet.Cells(y, 7) = "Yes"
                End If
            Else
                ActiveSheet.Cells(y, 6) = "UNABLE TO BIND"
            End If
            y = y + 1
            orecordset.MoveNext
        Wend
    End If
    Cells.Columns.AutoFit
    Application.ScreenUpdating = True
End Sub

Open in new window

0
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

Thanks

Mike
0

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.  
0
itsmevicAuthor Commented:
Worked great, thank you!
0
Mike KlineCommented:
Excellent glad to help.

0
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.