Hello everyone
The purpose of this script is to help Active Directory Administrator during the maintenance & administration of AD environment.
You'll be able to retrieve legacy (Old) computer objects (based on Computer Last Password Set date) into Excel and Disable the referred account.
Special thanks to
Richard L. Mueller, dm_4ever and Scott Mikesell '*************************************************************************************************
'* Retrieve and Disable Old(Legacy) Active Directory Computers Objects *
'* wrote by: Jeferson Propheta *
'* functions by Richard L. Mueller -
http://www.rlmueller.net/ *
'* and dm_4ever -
http://www.visualbasicscript.com/ *
'*************************************************************************************************
'* Last Update 08/08/2010 - Jeferson Propheta Added AutoConvert Function *
'*************************************************************************************************
'*************************************************************************************************
If LCase(Right(Wscript.FullName, 11)) = "wscript.exe" Then
strPath = Wscript.ScriptFullName
strCommand = "%comspec% /k cscript """ & strPath & """"
Set objShell = CreateObject("Wscript.Shell")
objShell.Run(strCommand), 1, True
Wscript.Quit
End If
'*************************************************************************************************
'* Create ado Connection *
'*************************************************************************************************
Wscript.Echo "***********************************************************************"
Wscript.Echo "Running: Retrieve and Disable Old AD Computers Accounts "
Wscript.Echo "***********************************************************************"
Wscript.Echo ""
Wscript.Echo "Creating ADODB Connection...."
Set adoCommand = CreateObject("ADODB.Command")
Set adoConnection = CreateObject("ADODB.Connection")
Wscript.Echo "->Starting ado Connection ADsDSOObject"
adoConnection.Provider = "ADsDSOObject"
Wscript.Echo "->Open Connection with Active Directory Provider"
adoConnection.Open "Active Directory Provider"
adoCommand.ActiveConnection = adoConnection
'*************************************************************************************************
'* LDAP AD Connection *
'*************************************************************************************************
Wscript.Echo""
Wscript.Echo "Retrieving Root Object - LDAP Connection"
Set objRootDSE = GetObject("
ldap://RootDSE/")
strDNSDomain = objRootDSE.Get("defaultNamingContext")
strBase = "<LDAP://" & strDNSDomain & ">"
Wscript.Echo "->" & strBase
'*************************************************************************************************
'* Calling Function to Convert actual date minus 120 day into Integer8 *
'*************************************************************************************************
call DateToInteger8(strNew)
'*************************************************************************************************
'* Creating Filter to query AD *
'*************************************************************************************************
strFilter = "(&(sAMAccountName=*$)(pwdLastSet<=" & strNew & ")(!(userAccountControl=2080)))"
Wscript.Echo "Creating LDAP Query: "
Wscript.Echo strFilter
If MsgBox("Do you want to Disable Old Computer Accounts?", vbQuestion + vbYesNo, "Old Accounts") = vbYes then
strDisableOldAccounts = "True"
strExclusion = InputBox("Type OU's you want to exclude from Accounting Block" & vbCrLf & _
"This will exclude all computers account within the Selected OU", , "OU=Shop Systems,OU=Legacy,OU=Brazil")
End if
strAttributes = "distinguishedName,lastLogon,pwdLastSet"
Wscript.Echo ""
Wscript.Echo "Getting Attributes: "
Wscript.Echo strAttributes
Wscript.Echo ""
Wscript.Echo "Executing ado Commands ..."
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False
Wscript.Echo ""
Wscript.Echo "Executing Query"
Set adoRecordset = adoCommand.Execute
Wscript.Echo "Initializing output File"
'*************************************************************************************************
'Starting Excel to Generate Report *
'*************************************************************************************************
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.Workbooks.Add
objExcel.Columns(1).ColumnWidth = 3
objExcel.Columns(2).ColumnWidth = 25
objExcel.Columns(3).ColumnWidth = 25
objExcel.Columns(4).ColumnWidth = 40
objExcel.Columns(5).ColumnWidth = 80
objExcel.Columns(6).ColumnWidth = 150
objExcel.ActiveCell.Font.Size = 12
objExcel.ActiveCell.Font.Bold = True
objExcel.ActiveCell.Value = "Legacy Computer Object List - " & Date & " - " & Time & " )"
objExcel.ActiveCell.Offset(2,0).Activate
objExcel.ActiveCell.Value = "#"
objExcel.ActiveCell.Offset(0,1).Activate
objExcel.ActiveCell.Value = "System Name"
objExcel.ActiveCell.Offset(0,1).Activate
objExcel.ActiveCell.Value = "Last Password Set"
objExcel.ActiveCell.Offset(0,1).Activate
objExcel.ActiveCell.Value = "DNS Name Resolution"
objExcel.ActiveCell.Offset(0,1).Activate
objExcel.ActiveCell.Value = "Location"
objExcel.ActiveCell.Offset(0,1).Activate
objExcel.ActiveCell.Value = "Distinguished Name"
objExcel.ActiveCell.Offset(0,-4).Activate
objExcel.Range("A3:F3").Select
objExcel.Selection.Font.Bold = True
objExcel.Selection.Interior.ColorIndex = 15
Wscript.Echo ""
WScript.StdOut.Write "->Reading Query Results...00%"
For i = 1 to 10
WScript.Sleep 100
WScript.StdOut.Write String(3, Chr(08)) & CStr(i * 10) & "%"
Next
Wscript.Echo ""
Do Until adoRecordset.EOF
strFullDN = adoRecordset.Fields("distinguishedName").Value
strDN = Replace(adoRecordset.Fields("distinguishedName").Value,","& strDNSDomain," ")
strLL = Integer8Date(adoRecordset.Fields("lastLogon").Value, lngTZBias)
strPLS = Integer8Date(adoRecordset.Fields("pwdLastSet").Value, lngTZBias)
arrstrDN = split(strDN,",")
strsystemName = Replace(arrstrDN(0),"CN=","")
strPingDNSName = ResolveIP(Replace(arrstrDN(0),"CN=","") & "." & Replace(Replace(strDNSDomain,"DC=",""),",","."))
For i = 1 to 10
Wscript.sleep 1
WScript.StdOut.Write String(1, ".")
Next
WScript.StdOut.Write " - Name Resolution request for host ... " & Replace(arrstrDN(0),"CN=","") & "." & Replace(Replace(strDNSDomain,"DC=",""),",",".")
Wscript.Echo ""
iCount = UBound(arrstrDN)
DO
strReverseOU = strReverseOU & Replace(Replace(Replace(arrstrDN(iCount),"OU=","|"),"CN=","" & "|"),",","|")
iCount = iCount - 1
Loop until iCount = 0
objExcel.ActiveCell.Offset(1,0).Activate
PCCount = PCCount + 1
objExcel.ActiveCell.Value = PCCount
objExcel.ActiveCell.Offset(0,1).Activate
objExcel.ActiveCell.Value = strsystemName
objExcel.ActiveCell.Offset(0,1).Activate
On Error Resume Next
objExcel.ActiveCell.Value = strPLS
If (Err.Number <> 0) Then
Err.Clear
objExcel.ActiveCell.Value = "Not Available"
ENd If
objExcel.ActiveCell.Offset(0,1).Activate
objExcel.ActiveCell.Value = strPingDNSName
objExcel.ActiveCell.Offset(0,1).Activate
objExcel.ActiveCell.Value = strReverseOU
objExcel.ActiveCell.Offset(0,1).Activate
objExcel.ActiveCell.Value = strFullDN
objExcel.ActiveCell.Offset(0,-5).Activate
If strDisableOldAccounts = "True" Then
If inStr(strDN, strExclusion) = False Then
Set ObjComputer = GetObject("LDAP://" & strDN & "," & strDNSDomain)
objComputer.AccountDisabled = True
objComputer.SetInfo
'objComputer.DeleteObject (0)
Else
End If
End If
strReverseOU = ""
adoRecordset.MoveNext
Loop
adoRecordset.Close
adoConnection.Close
MsgBox "Finished!", vbInformation + vbOKOnly, "Done"
Function Integer8Date(ByVal objDate, ByVal lngBias)
'by Richard L. Mueller -
http://www.rlmueller.net/ 'hilltoplab@rlmueller.net On Error Resume Next
TZBias
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
Integer8Date = CDate(lngDate)
If (Err.Number <> 0) Then
On Error GoTo 0
Integer8Date = #1/1/1601#
End If
On Error GoTo 0
End Function
Function TZBias()
' Obtain local Time Zone bias from machine registry.
' by Richard L. Mueller -
http://www.rlmueller.net/ '
hilltoplab@rlmueller.net 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)) = "VARIANT()") Then
lngTZBias = 0
For k = 0 To UBound(lngBiasKey)
lngTZBias = lngTZBias + (lngBiasKey(k) * 256^k)
Next
End If
End Function
Function ResolveIP(computerName)
'By dm_4ever
'
http://www.visualbasicscript.com Dim objShell : Set objShell = CreateObject("WScript.Shell")
Dim objExec : Set objExec = objShell.Exec("ping " & computerName & " -n 1")
Dim strOutput : strOutput = objExec.StdOut.ReadAll
Dim RegEx : Set RegEx = New RegExp
RegEx.Pattern = "\[(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})\]"
RegEx.Global = True
If RegEx.Test(strOutput) Then
ResolveIP = "Computers is Reachable IP: " & RegEx.Execute(strOutput)(0).Submatches(0)
Else
ResolveIP = "Host Name could not be resolved."
End If
End Function
Function DateToInteger8(Convertdate)
' by Richard L. Mueller -
http://www.rlmueller.net/ '
hilltoplab@rlmueller.net strDaysAgo = DateAdd("d", -120, FormatDateTime(Date(), 0)) & " 12:00 AM"
dtmDateValue = strDaysAgo
' 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
lngBias = lngBiasKey
ElseIf (UCase(TypeName(lngBiasKey)) = "VARIANT()") Then
lngBias = 0
For k = 0 To UBound(lngBiasKey)
lngBias = lngBias + (lngBiasKey(k) * 256^k)
Next
End If
' Convert datetime value to UTC.
dtmAdjusted = DateAdd("n", lngBias, dtmDateValue)
' Find number of seconds since 1/1/1601.
lngSeconds = DateDiff("s", #1/1/1601#, dtmAdjusted)
' Convert the number of seconds to a string
' and convert to 100-nanosecond intervals.
str64Bit = CStr(lngSeconds) & "0000000"
Convertdate = str64Bit
End Function
'*************************************************************************************************
'* Retrieve and Disable Old(Legacy) Active Directory Computers Objects *
'* wrote by: Jeferson Propheta *
'* functions by Richard L. Mueller - http://www.rlmueller.net/ *
'* and dm_4ever - http://www.visualbasicscript.com/ *
'*************************************************************************************************
'* Last Update 08/08/2010 - Jeferson Propheta Added AutoConvert Function *
'*************************************************************************************************
'*************************************************************************************************
If LCase(Right(Wscript.FullName, 11)) = "wscript.exe" Then
strPath = Wscript.ScriptFullName
strCommand = "%comspec% /k cscript """ & strPath & """"
Set objShell = CreateObject("Wscript.Shell")
objShell.Run(strCommand), 1, True
Wscript.Quit
End If '*************************************************************************************************
'* Create ado Connection *
'*************************************************************************************************
Wscript.Echo "***********************************************************************"
Wscript.Echo "Running: Retrieve and Disable Old AD Computers Accounts "
Wscript.Echo "***********************************************************************"
Wscript.Echo ""
Wscript.Echo "Creating ADODB Connection...."
Set adoCommand = CreateObject("ADODB.Command")
Set adoConnection = CreateObject("ADODB.Connection")
Wscript.Echo "->Starting ado Connection ADsDSOObject"
adoConnection.Provider = "ADsDSOObject"
Wscript.Echo "->Open Connection with Active Directory Provider"
adoConnection.Open "Active Directory Provider"
adoCommand.ActiveConnection = adoConnection
'*************************************************************************************************
'* LDAP AD Connection *
'*************************************************************************************************
Wscript.Echo""
Wscript.Echo "Retrieving Root Object - LDAP Connection"
Set objRootDSE = GetObject("ldap://RootDSE/")
strDNSDomain = objRootDSE.Get("defaultNamingContext")
strBase = "<LDAP://" & strDNSDomain & ">"
Wscript.Echo "->" & strBase
'*************************************************************************************************
'* Calling Function to Convert actual date minus 120 day into Integer8 *
'*************************************************************************************************
call DateToInteger8(strNew) '*************************************************************************************************
'* Creating Filter to query AD *
'************************************************************************************************* strFilter = "(&(sAMAccountName=*$)(pwdLastSet<=" & strNew & ")(!(userAccountControl=2080)))" Wscript.Echo "Creating LDAP Query: "
Wscript.Echo strFilter If MsgBox("Do you want to Disable Old Computer Accounts?", vbQuestion + vbYesNo, "Old Accounts") = vbYes then
strDisableOldAccounts = "True"
strExclusion = InputBox("Type OU's you want to exclude from Accounting Block" & vbCrLf & _
"This will exclude all computers account within the Selected OU", , "OU=Shop Systems,OU=Legacy,OU=Brazil")
End if
strAttributes = "distinguishedName,lastLogon,pwdLastSet"
Wscript.Echo ""
Wscript.Echo "Getting Attributes: "
Wscript.Echo strAttributes
Wscript.Echo ""
Wscript.Echo "Executing ado Commands ..."
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False
Wscript.Echo ""
Wscript.Echo "Executing Query" Set adoRecordset = adoCommand.Execute
Wscript.Echo "Initializing output File"
'*************************************************************************************************
'Starting Excel to Generate Report *
'*************************************************************************************************
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.Workbooks.Add
objExcel.Columns(1).ColumnWidth = 3
objExcel.Columns(2).ColumnWidth = 25
objExcel.Columns(3).ColumnWidth = 25
objExcel.Columns(4).ColumnWidth = 40
objExcel.Columns(5).ColumnWidth = 80
objExcel.Columns(6).ColumnWidth = 150
objExcel.ActiveCell.Font.Size = 12
objExcel.ActiveCell.Font.Bold = True
objExcel.ActiveCell.Value = "Legacy Computer Object List - " & Date & " - " & Time & " )"
objExcel.ActiveCell.Offset(2,0).Activate
objExcel.ActiveCell.Value = "#"
objExcel.ActiveCell.Offset(0,1).Activate
objExcel.ActiveCell.Value = "System Name"
objExcel.ActiveCell.Offset(0,1).Activate
objExcel.ActiveCell.Value = "Last Password Set"
objExcel.ActiveCell.Offset(0,1).Activate
objExcel.ActiveCell.Value = "DNS Name Resolution"
objExcel.ActiveCell.Offset(0,1).Activate
objExcel.ActiveCell.Value = "Location"
objExcel.ActiveCell.Offset(0,1).Activate
objExcel.ActiveCell.Value = "Distinguished Name"
objExcel.ActiveCell.Offset(0,-4).Activate
objExcel.Range("A3:F3").Select
objExcel.Selection.Font.Bold = True
objExcel.Selection.Interior.ColorIndex = 15
Wscript.Echo ""
WScript.StdOut.Write "->Reading Query Results...00%" For i = 1 to 10
WScript.Sleep 100
WScript.StdOut.Write String(3, Chr(08)) & CStr(i * 10) & "%"
Next
Wscript.Echo "" Do Until adoRecordset.EOF
strFullDN = adoRecordset.Fields("distinguishedName").Value
strDN = Replace(adoRecordset.Fields("distinguishedName").Value,","& strDNSDomain," ")
strLL = Integer8Date(adoRecordset.Fields("lastLogon").Value, lngTZBias)
strPLS = Integer8Date(adoRecordset.Fields("pwdLastSet").Value, lngTZBias)
arrstrDN = split(strDN,",")
strsystemName = Replace(arrstrDN(0),"CN=","")
strPingDNSName = ResolveIP(Replace(arrstrDN(0),"CN=","") & "." & Replace(Replace(strDNSDomain,"DC=",""),",","."))
For i = 1 to 10
Wscript.sleep 1
WScript.StdOut.Write String(1, ".")
Next
WScript.StdOut.Write " - Name Resolution request for host ... " & Replace(arrstrDN(0),"CN=","") & "." & Replace(Replace(strDNSDomain,"DC=",""),",",".")
Wscript.Echo ""
iCount = UBound(arrstrDN)
DO
strReverseOU = strReverseOU & Replace(Replace(Replace(arrstrDN(iCount),"OU=","|"),"CN=","" & "|"),",","|")
iCount = iCount - 1
Loop until iCount = 0 objExcel.ActiveCell.Offset(1,0).Activate
PCCount = PCCount + 1
objExcel.ActiveCell.Value = PCCount
objExcel.ActiveCell.Offset(0,1).Activate
objExcel.ActiveCell.Value = strsystemName
objExcel.ActiveCell.Offset(0,1).Activate
On Error Resume Next
objExcel.ActiveCell.Value = strPLS
If (Err.Number <> 0) Then
Err.Clear
objExcel.ActiveCell.Value = "Not Available"
ENd If
objExcel.ActiveCell.Offset(0,1).Activate
objExcel.ActiveCell.Value = strPingDNSName
objExcel.ActiveCell.Offset(0,1).Activate
objExcel.ActiveCell.Value = strReverseOU
objExcel.ActiveCell.Offset(0,1).Activate
objExcel.ActiveCell.Value = strFullDN
objExcel.ActiveCell.Offset(0,-5).Activate
If strDisableOldAccounts = "True" Then
If inStr(strDN, strExclusion) = False Then
Set ObjComputer = GetObject("LDAP://" & strDN & "," & strDNSDomain)
objComputer.AccountDisabled = True
objComputer.SetInfo
'objComputer.DeleteObject (0)
Else
End If
End If
strReverseOU = ""
adoRecordset.MoveNext
Loop adoRecordset.Close
adoConnection.Close MsgBox "Finished!", vbInformation + vbOKOnly, "Done" Function Integer8Date(ByVal objDate, ByVal lngBias)
'by Richard L. Mueller - http://www.rlmueller.net/
'hilltoplab@rlmueller.net
On Error Resume Next
TZBias
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
Integer8Date = CDate(lngDate)
If (Err.Number <> 0) Then
On Error GoTo 0
Integer8Date = #1/1/1601#
End If
On Error GoTo 0
End Function Function TZBias()
' Obtain local Time Zone bias from machine registry.
' by Richard L. Mueller - http://www.rlmueller.net/
' hilltoplab@rlmueller.net
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)) = "VARIANT()") Then
lngTZBias = 0
For k = 0 To UBound(lngBiasKey)
lngTZBias = lngTZBias + (lngBiasKey(k) * 256^k)
Next
End If
End Function Function ResolveIP(computerName)
'By dm_4ever
'http://www.visualbasicscript.com
Dim objShell : Set objShell = CreateObject("WScript.Shell")
Dim objExec : Set objExec = objShell.Exec("ping " & computerName & " -n 1")
Dim strOutput : strOutput = objExec.StdOut.ReadAll
Dim RegEx : Set RegEx = New RegExp
RegEx.Pattern = "\[(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})\]"
RegEx.Global = True
If RegEx.Test(strOutput) Then
ResolveIP = "Computers is Reachable IP: " & RegEx.Execute(strOutput)(0).Submatches(0)
Else
ResolveIP = "Host Name could not be resolved."
End If
End Function Function DateToInteger8(Convertdate)
' by Richard L. Mueller - http://www.rlmueller.net/
' hilltoplab@rlmueller.net
strDaysAgo = DateAdd("d", -120, FormatDateTime(Date(), 0)) & " 12:00 AM"
dtmDateValue = strDaysAgo ' 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
lngBias = lngBiasKey
ElseIf (UCase(TypeName(lngBiasKey)) = "VARIANT()") Then
lngBias = 0
For k = 0 To UBound(lngBiasKey)
lngBias = lngBias + (lngBiasKey(k) * 256^k)
Next
End If ' Convert datetime value to UTC.
dtmAdjusted = DateAdd("n", lngBias, dtmDateValue) ' Find number of seconds since 1/1/1601.
lngSeconds = DateDiff("s", #1/1/1601#, dtmAdjusted) ' Convert the number of seconds to a string
' and convert to 100-nanosecond intervals.
str64Bit = CStr(lngSeconds) & "0000000"
Convertdate = str64Bit
End Function