| |
Furd
Posts: 1
Score: 0
Joined: 9/16/2005
Status: offline
|
Calculates elapsed days since last login for all AD UserIDs. Also looks at last date profiles written to make sure you are getting the very last date that the account was signed off. Plug in your Profile folder names and your Domain name. Creates Excel readable (tab delimited fields) so you can sort by enabled/disabled, elapsed days, UserID, No Expires, etc. Comes in handy if you have a company policy to disable all accounts older than 60 days and/or delete all accounts older than 90 days. You don't have to go into AD Users and Computers manually and check each one. But, I did not code it to auto-disable or auto-suspend those old accounts because I needed to verify with users first.
Furd
'===========================================================================================
'CheckAccountDates VISUAL BASIC SCRIPT.
' GENERATES EXCEL READABLE SUMMARY OF ACCOUNT ACCESS DATES. COMBINES ACTIVE DIRECTORY AND
' PROFILE DATES (LAST WRITTEN TO) TO PROVIDE DAYS ELAPSED SINCE EACH ACCOUNT LAST ACCESSED.
'===========================================================================================
Dim fso, thisFile, thisLine, intCounter, intFound, retval, intLen, intEnd, thisName, thisDate
Dim arrItems, arrKeys, intDays, cmdFile, profile1, profile2, domName, domParm, objKeys, bSuccess
Dim lineOut, datExpires, datLastLogin, sumDisabled, sumNoExpire, sumAccounts, sDomain, oDomain
sumNoExpire = 0
sumDisabled = 0
sumAccounts = 0
profile1 = "\\powervault\profiles"
profile2 = "\\cheyenne\profiles"
domName = "TRAINING.CNC"
'=================================
On Error Resume Next
'=================================
'BUILD DICTIONARY (KEYED TABLE) OF PROFILE ACCESS DATES KEYED BY USERID.
' ------------------------------------------------------------------------
' CREATE CMD FILE CONTAINING DIR COMMANDS TO BE EXECUTED IN BATCH.
' NOTE THAT THE TW PARM TELLS DIR COMMAND TO EXTRACT DATE LAST WRITTEN.
' CREATES PROFILESLIST.TXT FILE CONTAINING LISTING OF PROFILES AND DATES.
' NOTE THAT SECOND DIR STATEMENT USES DOUBLE GREATER THAN SIGNS - APPENDS.
' ------------------------------------------------------------------------
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set cmdFile = objFSO.CreateTextFile("C:\ListProfiles.cmd")
lineOut = "dir /tw " & profile1 & " > C:\ProfilesList.txt"
cmdFile.WriteLine lineOut
lineOut = "dir /tw " & profile2 & " >> C:\ProfilesList.txt"
cmdFile.WriteLine lineOut
lineOut = "EXIT"
cmdFile.WriteLine lineOut
cmdFile.Close
' ---------------------------------------------------------
' RUN CMD BATCH FILE THAT WAS JUST CREATED ABOVE.
' ---------------------------------------------------------
set objScriptShell = CreateObject("Wscript.Shell")
objScriptShell.Run "cmd.exe /K C:\ListProfiles.cmd"
' ---------------------------------------------------------
' OPEN AND READ DIR LISTS FILE CREATED BY BATCH COMMAND ABOVE.
' STORE EACH UNIQUE USERID IN TABLE (DICTIONARY) ALONG WITH MOST
' RECENT DATE THAT EACH PROFILE WAS LAST WRITTEN.
' ---------------------------------------------------------
On Error Resume Next
Set objDict = CreateObject("Scripting.Dictionary")
If (FsoObject.FileExists("C:\ProfilesList.txt")) Then
MsgBox("Processing profile lists")
set fso = CreateObject("Scripting.FileSystemObject")
'THE STATEMENT BELOW OPENS THE FILE FOR READING.
set thisFile = fso.OpenTextFile("C:\ProfilesList.txt", 1, False, 0)
Do Until thisFile.AtEndOfStream
thisLine = thisFile.ReadLine
'-------------------------------------------------------------------------------------
' USERIDS START IN POSITION 40 ON EACH LINE SO EXTRACT FROM THERE.
'-------------------------------------------------------------------------------------
intEnd = Len(thisLine)
intLen = intEnd - 39
thisName = Mid(thisLine, 40, intLen)
thisDate = Left(thisLine, 10)
'-------------------------------------------------------------------------------------
' CHECK FOR VALID DATE - IF SO STORE IN DICTIONARY TABLE.
' NOTE THAT THE EXIST CLAUSE ENABLES DATE REPLACEMENT IF DATE IS NEWER.
' CDATE PUTS DATE STRINGS ON COMMON GROUND FOR COMPARISONS.
' THE TRIM FEATURE CHOPS LEADING AND TRAILING BLANKS FROM TARGET STRING.
' NON-USERID ENTRIES ARE INCONSEQUENTIAL SINCE PURPOSE OF TABLE IS LOOKUPS USING AD USERIDS.
' THISNAME(1) IS THE TABLE CELL CONTAINING THE DATE ASSOCIATED WITH THE THISNAME KEY.
' THE MSGBOX STATEMENT HALTS THE SCRIPT AND DISPLAYS SPECIFIED DATA.
' RETVAL HOLDS THE USER RESPONSE FROM MSGBOX - IF USER HIT CANCEL THEN VBCANCEL IS TRUE.
'-------------------------------------------------------------------------------------
If thisDate <> "" And IsDate(thisDate) Then
If objDict.Exists(Trim(thisName)) Then
If CDate(thisDate) > CDate(objDict.Item(Trim(thisName))(1)) Then
objTemp = objDict.Item(Trim(thisName))
objTemp(1) = thisDate
objDict.Item(Trim(thisName)) = objTemp
retval=MsgBox("Changed: " & " Name: " & thisName & " Date: " & thisDate, vbOkCancel,"Status")
If retval = vbcancel Then
Exit Do
End If
End If
Else
objDict.Add Trim(thisName), Array(thisName, thisDate)
End If
End If
Loop
thisFile.Close
retval=MsgBox("Completed Dict build with " & objDict.Count & " cells", vbOkCancel,"Status")
If retval = vbcancel Then
Abort
End If
' ---------------------------------------------------
' LIST DICTIONARY CONTENTS (UNTIL USER HITS CANCEL)
' ---------------------------------------------------
arrKeys = objDict.Keys
arrItems = objDict.Items
For intCounter = 0 To objDict.Count - 1
retval = MsgBox("Dict cell: " & intCounter & " " & arrItems(intCounter)(0) & _
" " & arrItems(intCounter)(1), vbOkCancel,"Status")
If retval = vbCancel Then
Exit For
End If
Next
MsgBox("Dictionary is built.")
Else
MsgBox("Aborting program - Profiles File does not exist")
Abort
End If
'===========================================================
'EXAMINE AD USER DATA FOR NO EXPIRATION AND LAST LOGIN DATES.
'===========================================================
' SET ODOMAIN WITH TARGET DOMAIN NAME AND FILTER BY USER NAME.
' --------------------------------------------------------
domParm = "WinNT://" & domName
Set oDomain = GetObject(domParm)
oDomain.Filter = Array("User")
' --------------------------------------------------------------------
' OPEN THE OUTPUT FILE - WILL BE TAB DELIMITED FOR OPENING WITH EXCEL.
' --------------------------------------------------------------------
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.CreateTextFile("Check_Accounts.txt")
lineOut = " Name" & vbTab & "LoginID" & vbTab & "Status" & vbTab & "Expiration" & vbTab & _
"Last Login" & vbTab & "Elapsed"
objFile.WriteLine lineOut
On Error Resume Next
' -------------------------------------------------------------------------------------
' NOTE: NEED TO DISPLAY A MESSAGE HERE REQUIRING NO RESPONSE, INFORMING TO PLEASE WAIT.
' BUT MSGBOX, TEXTBOX, LISTBOX ETC ALL HALT PROGRAM UNTIL USER RESPONDS.
' -------------------------------------------------------------------------------------
For Each oADobject in oDomain
sumAccounts = sumAccounts + 1
' ---------------------------------------------------------------
' ACCOUNTS HAVING NO EXPIRATION CONTAIN 1/1/1970 OR MAY BE NULL.
' OTHERWISE DO A GET USING LDAP VARIABLE NAME FOR EXPIRATION DATE.
' ---------------------------------------------------------------
If oADobject.AccountExpirationDate = #1/1/1970# Or oADobject.AccountExpirationDate = "" Then
datExpires = "1/1/1970"
sumNoExpire = sumNoExpire + 1
Else
datExpires = oADobject.Get("AccountExpirationDate")
If Err.Number = -2147467259 Or datExpires = #1/1/1970# Then
datExpires = "1/1/1970"
End If
End If
If oADobject.AccountDisabled Then
sumDisabled = sumDisabled + 1
lineOut = oADobject.Get("FullName") & vbTab & oADobject.Name & vbTab & "Disabled" & vbTab
Else
lineOut = oADobject.Get("FullName") & vbTab & oADobject.Name & vbTab & "Enabled" & vbTab
End If
lineOut = lineOut & datExpires & vbTab
datLastLogin = oADobject.Get("LastLogin")
datTemp = datLastLogin
If objDict.Exists(Trim(oADobject.Name)) Then
If CDate(datLastLogin) < CDate(objDict.Item(Trim(oADobject.Name))(1)) Then
datLastLogin = objDict.Item(Trim(oADobject.Name))(1)
End If
End If
' ---------------------------------------------------------------
' DATEDIFF FUNCTION RETURNS DIFFERENCE IN DAYS BETWEEN TWO DATES.
' ---------------------------------------------------------------
intDays = DateDiff("d", CDate(datLastLogin), Now)
lineOut = lineOut & datLastLogin & vbTab
lineOut = lineOut & intDays
objFile.WriteLine lineOut
Next
'===============================================================
'END OF LOOP THAT WAS READING ACTIVE DIRECTORY USER ENTRIES.
'WRITE FINAL INFO, CLEANUP, AND CLOSE DOWN.
'===============================================================
retVal = sumAccounts - sumDisabled
lineOut = " Total Accounts: " & sumAccounts & vbCrLf & " No Expire Date: " & sumNoExpire & _
vbCrLf & " Disabled: " & sumDisabled & vbCrLf & " Total Active: " & retVal
objFile.WriteLine lineOut
retval=MsgBox("All Done" & vbCrLf & lineOut, vbokcancel,"Status")
objFile.Close
Set objDict = Nothing
Set FsoObj = Nothing
Set objTemp = Nothing
'===============================================================
'END OF SCRIPT.
'===============================================================
|
|
Printable Version
Calculates elapsed days since last login all AD UserIDs - 
New Messages
No New Messages
Hot Topic w/ New Messages
Hot Topic w/o New Messages
Locked w/ New Messages
Locked w/o New Messages
Post New Thread