[Webinar] Streamline your web hosting managementRegister Today

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 594
  • Last Modified:

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!
0
itsmevic
Asked:
itsmevic
  • 4
  • 2
1 Solution
 
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
Has Powershell sent you back into the Stone Age?

If managing Active Directory using Windows Powershell® is making you feel like you stepped back in time, you are not alone.  For nearly 20 years, AD admins around the world have used one tool for day-to-day AD management: Hyena. Discover why.

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

0

Featured Post

The new generation of project management tools

With monday.com’s project management tool, you can see what everyone on your team is working in a single glance. Its intuitive dashboards are customizable, so you can create systems that work for you.

  • 4
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now