Announcement

Collapse
No announcement yet.

Extract Expired Accounts from AD

Collapse
X
  • Filter
  • Time
  • Show
Clear All
new posts

  • Extract Expired Accounts from AD

    I want to try and change this script to export all the expired user account from AD into and excel file. Right now this script that I found on the web exports them to a text file, using registry keys which I never really understand...Does anyone know where to start with this?

    Code:
    Dim conn, cmd, rs, user, high, low, expire, diff, shell, bKey, bias, c, expireAt, fso, outFile
    Set conn = CreateObject("ADODB.Connection")
    Set cmd = CreateObject("ADODB.Command")
    conn.provider = "adsdsoobject"
    conn.open "active directory provider"
    cmd.activeconnection = conn
    cmd.properties("cache results") = False
    cmd.commandtext = "<LDAP://" & GetObject("LDAP://rootdse").Get("defaultnamingcontext") & ">;(&(objectcategory=person)(objectclass=user));accountExpires,cn,samaccountname;subtree"
    Set rs = cmd.Execute
    Set fso = CreateObject("Scripting.FileSystemObject")
    set outFile = fso.CreateTextFile("ExpiredAccounts.txt",True)
    Set shell = CreateObject("Wscript.Shell")
    bKey = shell.RegRead("HKLM\System\CurrentControlSet\Control\TimeZoneInformation\ActiveTimeBias")
    If VarType(bKey) = 3 Then
    bias = bKey
    ElseIf VarType(bKey) = 12 Then
    For c = 0 To UBound(bKey)
    bias = bias + (bKey(k)*256^k)
    Next
    End If
    outFile.WriteLine "#common name,logon name,expired at"
    Do Until rs.eof
    diff = bias
    high = rs.fields("accountExpires").Value.HighPart
    low = rs.fields("accountExpires").Value.LowPart
    If low < 0 Then
    high = high + 1
    End If
    If high = 0 And low = 0 Then
    diff = 0
    End If
    If ((high*2^32+low)/600000000-diff)/1440 <> 0 And ((high*2^32+low)/600000000-diff)/1440 < 1000000 Then
    If DateDiff("d",DateAdd("d",((high*2^32+low)/600000000-diff)/1440,#1/1/1601#),Now) > 0 Then
    outFile.WriteLine rs.fields("cn").value & "," & rs.fields("samaccountname").value & "," & DateAdd("d",((high*2^32+low)/600000000-diff)/1440,#1/1/1601#)
    End If
    End If
    rs.movenext
    Loop
    outFile.Close
    WScript.Echo "Expired accounts have been written to ""ExpiredAccounts.txt"""

  • #2
    Re: Extract Expired Accounts from AD

    I know the excel part once I have the right for/next loop going....

    Comment


    • #3
      Re: Extract Expired Accounts from AD

      http://www.rlmueller.net/AccountExpires.htm ;
      The accountExpires attribute is an Integer8 attribute, which means it is a 64-bit (8 byte) number. It represents the number of 100-nanosecond intervals since 12:00 AM January 1, 1601, in UTC (Coordinated Universal Time, or what used to be called GMT). In VBScript, you must use the HighPart and LowPart methods of the IADsLargeInteger interface to convert the 64-bit number to a date. You should also use the time zone offset in the local machine registry to convert to the local time zone. convert Integer8 attributes

      The time is in UTC, to calculate it to the computers time zone the Bias is used. The BIAS in the script is read and calculated from a value in the registry.
      (instead, you can also use WMI http://forums.petri.com/showpost.php...71&postcount=5 to determine the BIAS)

      Instead of querying the AccountExpires attribute, you can also use the AccountExpirationDate property method http://www.microsoft.com/technet/scr...5/hey0902.mspx


      To write to a excelsheet:
      find the line containing 'outFile.WriteLine'. The first one of these lines adds the heads, one time. The second is in the loop and write each line.
      Replace the first 'WriteLine' line with lines open the workbook and add lines for titles/headers ect.
      The second 'WriteLine' line writes data, replace this for counting columns write the values to cells and upcount the row every time
      After the Loop save and close the worksheet


      \Rems

      This posting is provided "AS IS" with no warranties, and confers no rights.

      __________________

      ** Remember to give credit where credit's due **
      and leave Reputation Points for meaningful posts

      Comment


      • #4
        Re: Extract Expired Accounts from AD

        This is what I have so far... I dont' really know what to do with the BIAS part though...this is far from complete, I know I'm missing some things.

        Code:
        On Error Resume Next
        
        Const ADS_SCOPE_SUBTREE = 2
        
        Set objConnection = CreateObject("ADODB.Connection")
        Set objCommand =   CreateObject("ADODB.Command")
        objConnection.Provider = "ADsDSOObject"
        objConnection.Open "Active Directory Provider"
        Set objCommand.ActiveConnection = objConnection
        
        objCommand.Properties("Page Size") = 1000
        objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE 
        
        objCommand.CommandText = _
            "SELECT AdsPath FROM 'LDAP://dc=fabrikam,dc=com' WHERE objectCategory='user'"
        Set objRecordSet = objCommand.Execute
        
        objRecordSet.MoveFirst
        
        Set objUser = GetObject(objRecordSet.Fields("AdsPath").Value)
        
        strFile = "C:\Documents and Settings\ekrengel\Desktop\ExpiredAccountsTest.xls"
        
        Set objExcel = CreateObject("Excel.Application")
        objExcel.Visible = False
        objExcel.Workbooks.Add
        objExcel.Cells(1,1).Value = "All Expired Accounts in Domain "
        objExcel.Cells(1,1).Font.Bold = True
        objExcel.Cells(1,1).Font.Size = 13
        objExcel.Cells(1,1).Interior.ColorIndex = 11
        objExcel.Cells(1,1).Interior.Pattern = 1 'xlSolid 
        objExcel.Cells(1,1).Font.ColorIndex = 2
        objExcel.Cells(1,1).Borders.LineStyle = 1 '= xlSolid
        objExcel.Cells(1,1).WrapText = True
        
        objExcel.Cells(2,1).Value = "Time: " & Now
        objExcel.Cells(2,1).Font.Bold = True
        objExcel.Cells(2,1).Font.Size = 12
        objExcel.Cells(2,1).Interior.ColorIndex = 11 
        objExcel.Cells(2,1).Interior.Pattern = 1 'xlSolid 
        objExcel.Cells(2,1).Font.ColorIndex = 2
        objExcel.Cells(2,1).Borders.LineStyle = 1 '= xlSolid
        objExcel.Cells(2,1).WrapText = True
        
        objExcel.Cells(4,1).Value = "Common Name"
        objExcel.Cells(4,1).Font.Bold = True
        objExcel.Cells(4,1).Font.Size = 11
        objExcel.Cells(4,2).Value = "Logon Name"
        objExcel.Cells(4,2).Font.Bold = True
        objExcel.Cells(4,2).Font.Size = 11
        objExcel.Cells(4,3).Value = "Expiration Date"
        objExcel.Cells(4,3).Font.Bold = True
        objExcel.Cells(4,3).Font.Size = 11
        
        x = 5
        y = 1
        
         If objUser.AccountExpirationDate = "1/1/1970" Or Err.Number = -2147467259 Then
        
            For each objUser in objRecordSet
          
               strCommonName = 
               strLogonName = 
               strExpiredDate = 
        
            End If
        
        y1 = y
        
              objExcel.Cells(x,y1).Value = strCommonName
              y1 = y1 + 1
              objExcel.Cells(x,y1).Value =  strLogonNasme
              y1 = y1 + 1
              objExcel.Cells(x,y1).Value = strExpiredDate
        
        x = x + 1
        
        objRecordSet.MoveNext
        
        msgbox "Script Complete!"
        
        Wscript.Quit

        Comment


        • #5
          Re: Extract Expired Accounts from AD

          This script is using the AccountExpirationDate property method;
          Code:
          ' Name  : ExpiredUserAccounts.vbs
          ' Author: Remco Simons [NL] 2007
          '
          '  ( http://forums.petri.com/showthread.php?t=18676 )
          
          
          dt = FormatDateTime(Date(),vbshortdate) & " " & Time()
          
          Const ADS_SCOPE_SUBTREE = 2
          Const MULTIVALUED       = "Variant()"
          
          Dim arrExpUsers() : intSize=0
          
          'Start the ADO connection
          Set objRootDSE = GetObject("LDAP://rootDSE")
          strDNSDomain = objRootDSE.Get("defaultNamingContext")
          
          Set objCommand =  CreateObject("ADODB.Command")
          Set objConnection = CreateObject("ADODB.Connection")
          objConnection.Provider = "ADsDSOObject"
          objConnection.Open "Active Directory Provider"
          Set objCommand.ActiveConnection = objConnection
          
          objCommand.Properties("Page Size") = 1000
          objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE 
          
          objCommand.CommandText = _
              "SELECT AdsPath FROM 'LDAP://" & strDNSDomain & "' WHERE " _
              & "objectCategory='person' AND ObjectClass='user'"
          
          On Error Resume Next
          Set objRecordSet = objCommand.Execute
          If not objRecordSet.EOF Then 
           objRecordSet.MoveFirst
          
           Do Until objRecordSet.EOF
               Set objUser = GetObject(objRecordSet.Fields("AdsPath").Value)
               expDate = objUser.AccountExpirationDate
               If FormatDateTime(expDate,vbshortdate) _
                 = FormatDateTime("1/1/1970") _ 
                 OR FormatDateTime(expDate,vbshortdate) _
                 = FormatDateTime("1/1/1601") _
                 OR Err.Number = -2147467259 Then
                   '~ Account never expires ~
               Else
                 If DateDiff("n",dt,expDate) < 0 Then
                   ReDim Preserve arrExpUsers(intSize)
                     arrExpUsers(intSize) = objUser.Cn
                     intSize = intSize + 1
                   ReDim Preserve arrExpUsers(intSize)
                     arrExpUsers(intSize) = objUser.sAMAccountName
                     intSize = intSize + 1
                   ReDim Preserve arrExpUsers(intSize)
                     arrExpUsers(intSize) = expDate
                     intSize = intSize + 1
                 End If
               End If
               objRecordSet.MoveNext
           Loop
          End If
          objRecordSet.close
          objConnection.close
          On Error GoTo 0
          
          'Set objExcel = CreateObject("Excel.Application")
          'objExcel.Visible = False
          'objExcel.Workbooks.Add
          'ect. ect.
          'x = 5
          'y = 1
          
          
          If (TypeName(arrExpUsers) = MULTIVALUED) Then
           For i = 0 to intSize - 1 STEP 3
          
               wscript.echo arrExpUsers(i), arrExpUsers(i+1),arrExpUsers(i+2)
          
             ' y1 = y
             '  objExcel.Cells(x,y1).Value = arrExpUsers(i)   'strCommonName
             ' y1 = y1 + 1
             '  objExcel.Cells(x,y1).Value = arrExpUsers(i+1) 'strLogonNasme
             ' y1 = y1 + 1
             '  objExcel.Cells(x,y1).Value = arrExpUsers(i+2) 'strExpiredDate
             ' x = x + 1
          
           Next
          Else wscript.echo "No matches"
          End If
          
          '<...>
          'objWorkbook.Close
          'objExcel.Quit
          msgbox "Script Complete!"
          
          Wscript.Quit(0)
          Technically, accountExpirationDate is not an attribute of a user account; instead, it’s an Active Directory property method. The AccountExpirationDate property method is a holdover from NT domains, so it retains a few quirks.
          First, the “zero” date in NT domains was January 1, 1970.
          Any date that was undefined, or had the default zero value, was interpreted as 12:00 AM January 1, 1970.
          If a user object is configured to never expire, and the accountExpires attribute has a value of 0, AccountExpirationDate interprets this as January 1, 1970.
          Using 'On Error Resume Next' the script handles the situation when accountExpirationDate has no value, when you try to access this attribute it will return error number -2147467259 (the “Unspecified error” error).

          http://www.rlmueller.net/AccountExpires.htm


          And this script is using the accountExpires attribute;
          Code:
          Const ADS_SCOPE_SUBTREE = 2
          Const MULTIVALUED       = "Variant()"
          
          dt = FormatDateTime(Date(),vbshortdate) & " " & Time()
          
          ' Obtain local Time Zone bias from machine registry.
          Set objShell = CreateObject("Wscript.Shell")
          lngBiasKey = objShell.RegRead("HKLM\System\CurrentControlSet\Control\" _
              & "TimeZoneInformation\ActiveTimeBias")
          If (UCase(TypeName(lngBiasKey)) = "LONG") Then
              lngTZBias = lngBiasKey
          ElseIf (UCase(TypeName(lngBiasKey)) = MULTIVALUED) Then
              lngTZBias = 0
              For k = 0 To UBound(lngBiasKey)
                  lngTZBias = lngTZBias + (lngBiasKey(k) * 256^k)
              Next
          End If
          
          Dim arrExpUsers() : intSize=0
          
          'Start the ADO connection
          Set objRootDSE = GetObject("LDAP://rootDSE")
          strDNSDomain = objRootDSE.Get("defaultNamingContext")
          
          Set objCommand =  CreateObject("ADODB.Command")
          Set objConnection = CreateObject("ADODB.Connection")
          objConnection.Provider = "ADsDSOObject"
          objConnection.Open "Active Directory Provider"
          Set objCommand.ActiveConnection = objConnection
          
          objCommand.Properties("Page Size") = 1000
          objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE 
          
          objCommand.CommandText = _
              "SELECT AdsPath FROM 'LDAP://" & strDNSDomain & "' WHERE " _
              & "objectCategory='person' AND ObjectClass='user'"
          
          On Error Resume Next
          Set objRecordSet = objCommand.Execute
          If not objRecordSet.EOF Then 
           objRecordSet.MoveFirst
          
           Do Until objRecordSet.EOF
               Set objUser = GetObject(objRecordSet.Fields("AdsPath").Value)
               Set objExpDate = objUser.accountExpires
               expDate = Integer8Date(objExpDate, lngTZBias)
           If FormatDateTime(expDate,vbshortdate) _
                 = FormatDateTime("1/1/1970") _ 
                 OR FormatDateTime(expDate,vbshortdate) _
                 = FormatDateTime("1/1/1601") _
                 OR Err.Number = -2147467259 Then
                   '~ Account never expires ~
               Else
                 If DateDiff("n",dt,expDate) < 0 Then
                   ReDim Preserve arrExpUsers(intSize)
                     arrExpUsers(intSize) = objUser.Cn
                     intSize = intSize + 1
                   ReDim Preserve arrExpUsers(intSize)
                     arrExpUsers(intSize) = objUser.sAMAccountName
                     intSize = intSize + 1
                   ReDim Preserve arrExpUsers(intSize)
                     arrExpUsers(intSize) = expDate
                     intSize = intSize + 1
                 End If
               End If
               objRecordSet.MoveNext
           Loop
          End If
          objRecordSet.close
          objConnection.close
          On Error GoTo 0
          
          'Set objExcel = CreateObject("Excel.Application")
          'objExcel.Visible = False
          'objExcel.Workbooks.Add
          'ect. ect.
          'x = 5
          'y = 1
          
          
          If (TypeName(arrExpUsers) = MULTIVALUED) Then
           For i = 0 to intSize - 1 STEP 3
          
               wscript.echo arrExpUsers(i), arrExpUsers(i+1),arrExpUsers(i+2)
          
             ' y1 = y
             '  objExcel.Cells(x,y1).Value = arrExpUsers(i)   'strCommonName
             ' y1 = y1 + 1
             '  objExcel.Cells(x,y1).Value = arrExpUsers(i+1) 'strLogonNasme
             ' y1 = y1 + 1
             '  objExcel.Cells(x,y1).Value = arrExpUsers(i+2) 'strExpiredDate
             ' x = x + 1
          
           Next
          Else wscript.echo "No matches"
          End If
          
          '<...>
          'objWorkbook.Close
          'objExcel.Quit
          msgbox "Script Complete!"
          
          Wscript.Quit(0)
          
          Function Integer8Date(ByVal objDate, ByVal 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 error 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
              ' Trap error if lngDate is ridiculously huge.
              On Error Resume Next
              Integer8Date = CDate(lngDate)
              If (Err.Number <> 0) Then
                  On Error GoTo 0
                  Integer8Date = #1/1/1601#
              End If
              On Error GoTo 0
          End Function
          (The differences in code between the two methods are in red)

          If you run both script there is a chance you'll see a difference in account exparation date.
          The last script is more more precisely, as you can read about it in the articles by Richard Mueller.

          \Rems
          Last edited by Rems; 25th October 2007, 21:41.

          This posting is provided "AS IS" with no warranties, and confers no rights.

          __________________

          ** Remember to give credit where credit's due **
          and leave Reputation Points for meaningful posts

          Comment


          • #6
            Re: Extract Expired Accounts from AD

            sorry to ask, but can't you just do an active directory search to a virtual container..for disabled users?..and then just action > export list...


            right click saved queries > all tasks > new query > > click on disabled users..

            this will give you the list


            right click on the white space and export list..to a csv file.

            sorry if this is far from what you wanted.

            Comment


            • #7
              Re: Extract Expired Accounts from AD

              Yeah thats not it because those are all "disabled users." I just want the accounts that are expired...expired accounts aren't the same as being disabled.

              Comment


              • #8
                Re: Extract Expired Accounts from AD

                Heh, I wasn't even close with what I had...thanks Rems!

                Comment


                • #9
                  Re: Extract Expired Accounts from AD

                  You are welcome,
                  Originally posted by ekrengel View Post
                  Heh, I wasn't even close with what I had...thanks Rems!
                  You were close,
                  In my example I didn't wite to the worksheet during the loop, I first created an array. But that is not realy nessesary, what you did will work too.
                  I created the array because in the 'Hey scripting guy' they told this method would be slow, and I didn't want the worksheet to stay open that long.
                  But after I finished the script, I didn't think it was running that slow.
                  What mainly went wrong in your version was that you filter the accounts that 'never exipres'. That is where I added the 'ELSE'. Then I calculated the timediff between the current datetime and the entered date so only the 'already expired' accounts will be selected.

                  \Rems
                  Last edited by Rems; 14th October 2007, 23:03.

                  This posting is provided "AS IS" with no warranties, and confers no rights.

                  __________________

                  ** Remember to give credit where credit's due **
                  and leave Reputation Points for meaningful posts

                  Comment


                  • #10
                    Re: Extract Expired Accounts from AD

                    So I added the excel part, and tested it out, but I'm not getting any output in the spreadsheet from the arrays....When I tested with just the echo, I did not get any output either.

                    Code:
                    dt = FormatDateTime(Date(),vbshortdate) & " " & Time()
                    
                    Const ADS_SCOPE_SUBTREE = 2
                    Const MULTIVALUED       = "Variant()"
                    
                    Dim arrExpUsers() : intSize=0
                    
                    'Start the ADO connection
                    Set objRootDSE = GetObject("LDAP://rootDSE")
                    strDNSDomain = objRootDSE.Get("defaultNamingContext")
                    
                    Set objConnection = CreateObject("ADODB.Connection")
                    Set objCommand =   CreateObject("ADODB.Command")
                    objConnection.Provider = "ADsDSOObject"
                    objConnection.Open "Active Directory Provider"
                    Set objCommand.ActiveConnection = objConnection
                    
                    objCommand.Properties("Page Size") = 1000
                    objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE 
                    
                    objCommand.CommandText = _
                        "SELECT AdsPath FROM 'LDAP://" & strDNSDomain & "' WHERE " _
                        & "objectCategory='person' AND ObjectClass='user'"
                    
                    Set objRecordSet = objCommand.Execute
                    If not objRecordSet.EOF Then objRecordSet.MoveFirst
                    
                    On Error Resume Next
                    Do Until objRecordSet.EOF
                        Set objUser = GetObject(objRecordSet.Fields("AdsPath").Value)
                        expDate = objUser.AccountExpirationDate
                        If FormatDateTime(expDate,vbshortdate) _
                          = FormatDateTime("1/1/1970") _ 
                          OR FormatDateTime(expDate,vbshortdate) _
                          = FormatDateTime("1/1/1601") _
                          OR Err.Number = -2147467259 Then
                            '~ Account never expires ~
                        Else
                          If DateDiff("n",dt,expDate) < 0 Then
                            ReDim Preserve arrExpUsers(intSize)
                              arrExpUsers(intSize) = objUser.Cn
                              intSize = intSize + 1
                            ReDim Preserve arrExpUsers(intSize)
                              arrExpUsers(intSize) = objUser.sAMAccountName
                              intSize = intSize + 1
                            ReDim Preserve arrExpUsers(intSize)
                              arrExpUsers(intSize) = expDate
                              intSize = intSize + 1
                          End If
                        End If
                        objRecordSet.MoveNext
                    Loop
                    On Error GoTo 0
                    
                    strFile = "C:\Documents and Settings\ekrengel\Desktop\ExpiredAccountsTest.xls"
                    
                    Set objExcel = CreateObject("Excel.Application")
                    objExcel.Visible = False
                    objExcel.Workbooks.Add
                    objExcel.Cells(1,1).Value = "All Expired Accounts in Domain "
                    objExcel.Cells(1,1).Font.Bold = True
                    objExcel.Cells(1,1).Font.Size = 13
                    objExcel.Cells(1,1).Interior.ColorIndex = 11
                    objExcel.Cells(1,1).Interior.Pattern = 1 'xlSolid 
                    objExcel.Cells(1,1).Font.ColorIndex = 2
                    objExcel.Cells(1,1).Borders.LineStyle = 1 '= xlSolid
                    objExcel.Cells(1,1).WrapText = True
                    
                    objExcel.Cells(2,1).Value = "Time: " & Now
                    objExcel.Cells(2,1).Font.Bold = True
                    objExcel.Cells(2,1).Font.Size = 12
                    objExcel.Cells(2,1).Interior.ColorIndex = 11 
                    objExcel.Cells(2,1).Interior.Pattern = 1 'xlSolid 
                    objExcel.Cells(2,1).Font.ColorIndex = 2
                    objExcel.Cells(2,1).Borders.LineStyle = 1 '= xlSolid
                    objExcel.Cells(2,1).WrapText = True
                    
                    objExcel.Cells(4,1).Value = "Common Name"
                    objExcel.Cells(4,1).Font.Bold = True
                    objExcel.Cells(4,1).Font.Size = 11
                    objExcel.Cells(4,2).Value = "Logon Name"
                    objExcel.Cells(4,2).Font.Bold = True
                    objExcel.Cells(4,2).Font.Size = 11
                    objExcel.Cells(4,3).Value = "Expiration Date"
                    objExcel.Cells(4,3).Font.Bold = True
                    objExcel.Cells(4,3).Font.Size = 11
                    
                    x = 5
                    y = 1
                    
                    If (TypeName(arrExpUsers) = MULTIVALUED) Then
                     For i = 0 to intSize - 1 STEP 3
                    
                    y1 = y
                    
                    'wscript.echo arrExpUsers(i), arrExpUsers(i+1),arrExpUsers(i+2)
                    
                         objExcel.Cells(x,y1).Value = arrExpUsers(i)   
                         y1 = y1 + 1
                         objExcel.Cells(x,y1).Value = arrExpUsers(i+1) 
                          y1 = y1 + 1
                         objExcel.Cells(x,y1).Value = arrExpUsers(i+2) 
                    
                    x = x + 1
                    
                    Next
                       Else wscript.echo "No matches"
                    End If
                    
                    objExcel.Columns("A:C").Select
                    objExcel.Selection.HorizontalAlignment = 3 'xlCenter
                    objExcel.Selection.Borders.LineStyle = 1 '= xlSolid
                    
                    objExcel.Range("A1","C1").MergeCells = 1
                    objExcel.Range("A2","C2").MergeCells = 1
                    
                    objExcel.Range("A5:C65536").Sort objExcel.Range("A5"),,,,,,,0
                    
                    objExcel.Columns("A:AH").EntireColumn.AutoFit
                    
                    objExcel.DisplayAlerts = False
                    Set objWorkbook = objExcel.ActiveWorkbook
                    objWorkbook.SaveAs strFile
                    objWorkbook.Close
                    objExcel.Quit
                    
                    msgbox "Script Complete!"
                    
                    Wscript.Quit(0)

                    Comment


                    • #11
                      Re: Extract Expired Accounts from AD

                      Test the basic method, by running the script below direct from one of the dcs

                      Code:
                      dt = FormatDateTime(Date(),vbshortdate) & " " & Time()
                      
                      Const ADS_SCOPE_SUBTREE = 2
                      Const MULTIVALUED       = "Variant()"
                      
                      Dim arrExpUsers() : intSize=0
                      
                      'Start the ADO connection
                      Set objRootDSE = GetObject("LDAP://rootDSE")
                      strDNSDomain = objRootDSE.Get("defaultNamingContext")
                      
                      Set objConnection = CreateObject("ADODB.Connection")
                      Set objCommand =   CreateObject("ADODB.Command")
                      objConnection.Provider = "ADsDSOObject"
                      objConnection.Open "Active Directory Provider"
                      Set objCommand.ActiveConnection = objConnection
                      
                      objCommand.Properties("Page Size") = 1000
                      objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE 
                      
                      objCommand.CommandText = _
                          "SELECT AdsPath FROM 'LDAP://" & strDNSDomain & "' WHERE " _
                          & "objectCategory='person' AND ObjectClass='user'"
                      
                      Set objRecordSet = objCommand.Execute
                      If not objRecordSet.EOF Then objRecordSet.MoveFirst
                      
                      On Error Resume Next
                      Do Until objRecordSet.EOF
                          Set objUser = GetObject(objRecordSet.Fields("AdsPath").Value)
                          expDate = objUser.AccountExpirationDate
                          If FormatDateTime(expDate,vbshortdate) _
                            = FormatDateTime("1/1/1970") _ 
                            OR FormatDateTime(expDate,vbshortdate) _
                            = FormatDateTime("1/1/1601") _
                            OR Err.Number = -2147467259 Then
                              'Account never expires
                          Else
                            If DateDiff("n",dt,expDate) < 0 Then
                      
                      wscript.echo objUser.Cn, "|", objUser.sAMAccountName, "|", expDate
                      
                            End If
                          End If
                          objRecordSet.MoveNext
                      Loop
                      On Error GoTo 0
                      
                      msgbox "Script finished!"
                      
                      Wscript.Quit(0)
                      This runs fine on our dc's (English version of Windows server 2003 st.ed R2 sp2)

                      \Rems

                      This posting is provided "AS IS" with no warranties, and confers no rights.

                      __________________

                      ** Remember to give credit where credit's due **
                      and leave Reputation Points for meaningful posts

                      Comment


                      • #12
                        Re: Extract Expired Accounts from AD

                        Yeah I do not get anything out of that one either...We have Windows server 2003 st.ed R2 sp2 as well. I'm not sure what the problem is...

                        Comment


                        • #13
                          Re: Extract Expired Accounts from AD

                          May be the 'shortDate' notation? What language is your Server OS?

                          from the script I get: 10/23/2007 11:11:27 PM (shortDate ,and Time)
                          test:
                          Code:
                          dt = FormatDateTime(Date(),vbshortdate) & " " & Time()
                          
                          WSCRIPT.ECHO dt
                          
                          Const ADS_SCOPE_SUBTREE = 2
                          Const MULTIVALUED       = "Variant()"
                          
                          Dim arrExpUsers() : intSize=0
                          
                          'Start the ADO connection
                          Set objRootDSE = GetObject("LDAP://rootDSE")
                          strDNSDomain = objRootDSE.Get("defaultNamingContext")
                          
                          Set objConnection = CreateObject("ADODB.Connection")
                          Set objCommand =   CreateObject("ADODB.Command")
                          objConnection.Provider = "ADsDSOObject"
                          objConnection.Open "Active Directory Provider"
                          Set objCommand.ActiveConnection = objConnection
                          
                          objCommand.Properties("Page Size") = 1000
                          objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE 
                          
                          objCommand.CommandText = _
                              "SELECT AdsPath FROM 'LDAP://" & strDNSDomain & "' WHERE " _
                              & "objectCategory='person' AND ObjectClass='user'"
                          
                          Set objRecordSet = objCommand.Execute
                          If not objRecordSet.EOF Then objRecordSet.MoveFirst
                          
                          ' comment: On Error Resume Next
                          Do Until objRecordSet.EOF
                              Set objUser = GetObject(objRecordSet.Fields("AdsPath").Value)
                              expDate = objUser.AccountExpirationDate
                              If FormatDateTime(expDate,vbshortdate) _
                                = FormatDateTime("1/1/1970") _ 
                                OR FormatDateTime(expDate,vbshortdate) _
                                = FormatDateTime("1/1/1601") _
                                OR Err.Number = -2147467259 Then
                                  'Account never expires
                              Else
                          
                          wscript.echo objUser.Cn, "|", objUser.sAMAccountName, "|", expDate
                          
                              End If
                              objRecordSet.MoveNext
                          Loop
                          On Error GoTo 0
                          
                          msgbox "Script finished!"
                          
                          Wscript.Quit(0)
                          I also comment out the line: On Error Resume Next
                          maybe you will able to see an error message now if there are any.


                          next step is to replace the loop:
                          Code:
                          'On Error Resume Next
                          Do Until objRecordSet.EOF
                              Set objUser = GetObject(objRecordSet.Fields("AdsPath").Value)
                          
                          wscript.echo objUser.Cn, "|", objUser.sAMAccountName
                          
                              objRecordSet.MoveNext
                          Loop
                          On Error GoTo 0
                          Now it should popup just every useraccount. (?)
                          (you can quit this wscript.exe process by using taskmanager)

                          \Rems

                          This posting is provided "AS IS" with no warranties, and confers no rights.

                          __________________

                          ** Remember to give credit where credit's due **
                          and leave Reputation Points for meaningful posts

                          Comment


                          • #14
                            Re: Extract Expired Accounts from AD

                            We are English. I get the date echo'd back from the dt, but then after I get an error.

                            line: 33
                            char: 5
                            error: unspecified error
                            code: 80004005

                            That line is "expDate = objUser.AccountExpirationDate".

                            Comment


                            • #15
                              Re: Extract Expired Accounts from AD

                              Troubleshooting Code Error 80004005 - Unspecified Error
                              "With error 80004005 there is usually an element of access denied. Insufficient rights, wrong permissions.
                              It can occur when a VBScript attempts to connect to scriptpw.dll. There are other causes, such as connecting to COM objects or ADO, or other database object.
                              "


                              Could it be that
                              Or the 'AccountExpirationDate property method' is not working (?)
                              Or there is something unexpected with an userobject (?)
                              The find out what user that might be- first wscript.echo objUser.Cn
                              then wscript.echo objUser.AccountExpirationDate
                              Remember the last name before the error occour, and go to the properties of that user in ADU&C.


                              Lets go back to the method you did first, not using the AccountExpirationDate property method but using the accountExpires attribute;
                              Code:
                              Const ADS_SCOPE_SUBTREE = 2
                              Const MULTIVALUED       = "Variant()"
                              
                              dt = FormatDateTime(Date(),vbshortdate) & " " & Time()
                              
                              ' Obtain local Time Zone bias from machine registry.
                              Set objShell = CreateObject("Wscript.Shell")
                              lngBiasKey = objShell.RegRead("HKLM\System\CurrentControlSet\Control\" _
                                  & "TimeZoneInformation\ActiveTimeBias")
                              If (UCase(TypeName(lngBiasKey)) = "LONG") Then
                                  lngTZBias = lngBiasKey
                              ElseIf (UCase(TypeName(lngBiasKey)) = MULTIVALUED) Then
                                  lngTZBias = 0
                                  For k = 0 To UBound(lngBiasKey)
                                      lngTZBias = lngTZBias + (lngBiasKey(k) * 256^k)
                                  Next
                              End If
                              
                              Dim arrExpUsers() : intSize=0
                              
                              'Start the ADO connection
                              Set objRootDSE = GetObject("LDAP://rootDSE")
                              strDNSDomain = objRootDSE.Get("defaultNamingContext")
                              
                              Set objConnection = CreateObject("ADODB.Connection")
                              Set objCommand =   CreateObject("ADODB.Command")
                              objConnection.Provider = "ADsDSOObject"
                              objConnection.Open "Active Directory Provider"
                              Set objCommand.ActiveConnection = objConnection
                              
                              objCommand.Properties("Page Size") = 1000
                              objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE 
                              
                              objCommand.CommandText = _
                                  "SELECT AdsPath FROM 'LDAP://" & strDNSDomain & "' WHERE " _
                                  & "objectCategory='person' AND ObjectClass='user'"
                              
                              Set objRecordSet = objCommand.Execute
                              If not objRecordSet.EOF Then objRecordSet.MoveFirst
                              
                              On Error Resume Next
                              Do Until objRecordSet.EOF
                                  Set objUser = GetObject(objRecordSet.Fields("AdsPath").Value)
                                  Set objExpDate = objUser.accountExpires
                                  expDate = Integer8Date(objExpDate, lngTZBias)
                              If FormatDateTime(expDate,vbshortdate) _
                                    = FormatDateTime("1/1/1970") _ 
                                    OR FormatDateTime(expDate,vbshortdate) _
                                    = FormatDateTime("1/1/1601") _
                                    OR Err.Number = -2147467259 Then
                                      '~ Account never expires ~
                                  Else
                                    If DateDiff("n",dt,expDate) < 0 Then
                                      ReDim Preserve arrExpUsers(intSize)
                                        arrExpUsers(intSize) = objUser.Cn
                                        intSize = intSize + 1
                                      ReDim Preserve arrExpUsers(intSize)
                                        arrExpUsers(intSize) = objUser.sAMAccountName
                                        intSize = intSize + 1
                                      ReDim Preserve arrExpUsers(intSize)
                                        arrExpUsers(intSize) = expDate
                                        intSize = intSize + 1
                                    End If
                                  End If
                                  objRecordSet.MoveNext
                              Loop
                              On Error GoTo 0
                              
                              'Set objExcel = CreateObject("Excel.Application")
                              'objExcel.Visible = False
                              'objExcel.Workbooks.Add
                              'ect. ect.
                              'x = 5
                              'y = 1
                              
                              
                              If (TypeName(arrExpUsers) = MULTIVALUED) Then
                               For i = 0 to intSize - 1 STEP 3
                              
                                   wscript.echo arrExpUsers(i), arrExpUsers(i+1),arrExpUsers(i+2)
                              
                                 ' y1 = y
                                 '  objExcel.Cells(x,y1).Value = arrExpUsers(i)   'strCommonName
                                 ' y1 = y1 + 1
                                 '  objExcel.Cells(x,y1).Value = arrExpUsers(i+1) 'strLogonNasme
                                 ' y1 = y1 + 1
                                 '  objExcel.Cells(x,y1).Value = arrExpUsers(i+2) 'strExpiredDate
                                 ' x = x + 1
                              
                               Next
                              Else wscript.echo "No matches"
                              End If
                              
                              '<...>
                              'objWorkbook.Close
                              'objExcel.Quit
                              msgbox "Script Complete!"
                              
                              Wscript.Quit(0)
                              
                              Function Integer8Date(ByVal objDate, ByVal 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 error 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
                                  ' Trap error if lngDate is ridiculously huge.
                                  On Error Resume Next
                                  Integer8Date = CDate(lngDate)
                                  If (Err.Number <> 0) Then
                                      On Error GoTo 0
                                      Integer8Date = #1/1/1601#
                                  End If
                                  On Error GoTo 0
                              End Function
                              (The differences in code between the two methods are in red)

                              Does this work on your DC?
                              (if not comment the line: On Error Resume Next again to get an error message)

                              \Rems

                              This posting is provided "AS IS" with no warranties, and confers no rights.

                              __________________

                              ** Remember to give credit where credit's due **
                              and leave Reputation Points for meaningful posts

                              Comment

                              Working...
                              X