script which emails a list of account expiration dates

I am using findexpacc currently to ouput a list of expiring accounts. However the output is not configurable and it only outputs to a text file which then has to be attached to an email. so its not working to well for me. i want a script which generates an email which contains a list of any accounts with account expiration enabled. the list would contain username, display name, expiration date. thanks in advance!
hartwellcorpAsked:
Who is Participating?
 
yo_beeConnect With a Mentor Director of Information TechnologyCommented:
Here is a modified version of the script.
Note:
Line 111,112,113 & 119  need to be modified.
Line 114 does not have to be modified. Leave the strbody as is.
I removed the message box echos so you can run the VBS without having to run it from a command prompt.


'Option Explicit

Dim oShell
Dim strSchemaPath
Dim objConnection
Dim ojRS
Dim StrAttr, strName, strattribute
Dim strLDAP
Dim objConn 'ADO Connection object
Dim objRS 'ADO Recordset object
Dim strAlt ' As Boolean
Dim StrADs
Dim strclass
Dim strSam, strobjFilter, strattrFilter 
Dim objWMIService, objitem, objUser
Dim strUserDN, lngTZBias
Dim objShell, lngBiasKey, k
Dim strWrite
Dim objAccountExpires

Set oShell = WScript.CreateObject ("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")

strWrite = "<table border ='1'><tr><th>UserName</th><th>DisplayName</th><th>Date</th></tr>"

' Obtain local Time Zone bias from machine registry.
' This bias changes with Daylight Savings Time.
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



'AD gathering
'Get the Root DSE from a random DC
Set objRootDSE = GetObject("LDAP://RootDSE")

'Connect to the schema container on a random DC
strDNSDomain = objRootDSE.Get("defaultNamingContext")

'wscript.echo strDNSDomain
       
'Makes a connection to AD using ADODB (ADSI)
       set objConnection = CreateObject("ADODB.Connection")
       Set objCommand = CreateObject("ADODB.Command")
       objConnection.Provider = "ADsDSOObject"
       objConnection.Open("Active Directory Provider")
       objCommand.ActiveConnection = objConnection



Set objRS  = objConnection.Execute("<LDAP://" & strDNSDomain & ">;(&(objectCategory=person)" _
& "(objectClass=user)(!accountexpires=9223372036854775807)(!accountexpires=0));Name,ADsPath,accountExpires;SubTree") '
   	
While Not objRS.EOF
set ObjUser = GetObject(objRs.Fields("ADsPath").value)
Set objDate = objUser.accountExpires
objAccountExpires = Integer8Date(objDate, lngTZBias)

'wscript.echo objuser.sAMAccountName & vbtab & objuser.displayName & vbtab & objAccountExpires
strWrite = StrWrite & "<tr><td>" & objuser.sAMAccountName & "</td><td>" & objuser.displayName & "</td><td>" & objAccountExpires & "</td></tr>"
objRS.MoveNext
Wend
Set objRS = Nothing
objConnection.Close   
strwrite = strwrite & "</table>"


EmailADMIN(StrWrite)

'Converts the Long integer to a readable date
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


Function EmailADMIN(Byval StrBody)


Set objEmail = CreateObject("CDO.Message")
objEmail.From = "administrator@XXXXXX.local" '"AD Audit"
objEmail.To = "Enter Recipients address" '"Admin@Domain.local"
objEmail.Subject = "<Enter your SUBJECT LINE>"
objEmail.HTMLBody = Strbody 
'obj'Email.addattachment("c:\Audit.csv")
objEmail.Configuration.Fields.Item _
 ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objEmail.Configuration.Fields.Item _
 ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "<enter server name or IP"
objEmail.Configuration.Fields.Item _
 ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objEmail.Configuration.Fields.Update
objEmail.Send

End Function

Open in new window

0
 
yo_beeDirector of Information TechnologyCommented:
When you  say expiring, what do you mean by expiring.
Do you have a setting that account will close after a certain about of time?
0
 
yo_beeDirector of Information TechnologyCommented:
Here is something I put together.
I had some help with the date conversation since it was in a long integer (integer8todate) and I was not sure myself.

This is a VBS file and there are some values that you will need to modify to fit your environment.
Line 73: File Name that will be writen to.
Line 113,114: From and To addresses
Line 121: the SMTP server
 
'Option Explicit

Dim oShell
Dim strSchemaPath
Dim objConnection
Dim ojRS
Dim StrAttr, strName, strattribute
Dim strLDAP
Dim objConn 'ADO Connection object
Dim objRS 'ADO Recordset object
Dim strAlt ' As Boolean
Dim StrADs
Dim strclass
Dim strSam, strobjFilter, strattrFilter 
Dim objWMIService, objitem, objUser
Dim strUserDN, lngTZBias
Dim objShell, lngBiasKey, k
Dim strWrite
Dim objAccountExpires

Set oShell = WScript.CreateObject ("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
strWrite = "UserName,DisplayName,Date" & vbcrlf
' Obtain local Time Zone bias from machine registry.
' This bias changes with Daylight Savings Time.
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



'AD gathering
'Get the Root DSE from a random DC
Set objRootDSE = GetObject("LDAP://RootDSE")

'Connect to the schema container on a random DC
strDNSDomain = objRootDSE.Get("defaultNamingContext")

wscript.echo strDNSDomain
       
'Makes a connection to AD using ADODB (ADSI)
       set objConnection = CreateObject("ADODB.Connection")
       Set objCommand = CreateObject("ADODB.Command")
       objConnection.Provider = "ADsDSOObject"
       objConnection.Open("Active Directory Provider")
       objCommand.ActiveConnection = objConnection


'msgbox (CDbl(DateDiff("s", CDate("01/01/1601 00:00:00"), Now - 1)))
Set objRS  = objConnection.Execute("<LDAP://" & strDNSDomain & ">;(&(objectCategory=person)" _
& "(objectClass=user)(!accountexpires=9223372036854775807)(!accountexpires=0));Name,ADsPath,accountExpires;SubTree") '
   	
While Not objRS.EOF
set ObjUser = GetObject(objRs.Fields("ADsPath").value)
Set objDate = objUser.accountExpires
objAccountExpires = Integer8Date(objDate, lngTZBias)
wscript.echo objuser.sAMAccountName & "," & objuser.displayName & "," & objAccountExpires
strWrite = StrWrite & objuser.sAMAccountName & "," & objuser.displayName & "," & objAccountExpires & vbcrlf
objRS.MoveNext
Wend
Set objRS = Nothing
objConnection.Close   

'Writes the log file
set strNewFile = objFSO.createtextfile("c:\Audit.csv", true)
strNewFile = "C:\Audit.csv"
Set objFile = objFSO.OpenTextFile(strNewFile, 2)
objFile.WriteLine strWrite
objFile.Close

EmailADMIN

'Converts the Long integer to a readable date
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


Function EmailADMIN


Set objEmail = CreateObject("CDO.Message")
objEmail.From = "Somename@domain.local" '"AD Audit"
objEmail.To = "somename@domain.local" '"Admin@Domain.local"
objEmail.Subject = "<Enter your SUBJECT LINE>"
objEmail.Textbody = "<Enter body info>" '"Enter the text desired" 
objEmail.addattachment("c:\Audit.csv")
objEmail.Configuration.Fields.Item _
 ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objEmail.Configuration.Fields.Item _
 ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "<Exchange server name or IP"
objEmail.Configuration.Fields.Item _
 ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objEmail.Configuration.Fields.Update
objEmail.Send

End Function

Open in new window

0
Making Bulk Changes to Active Directory

Watch this video to see how easy it is to make mass changes to Active Directory from an external text file without using complicated scripts.

 
hartwellcorpAuthor Commented:
Wow thanks! This is great. i updated the lines you suggested and ran it. Seems to be partially working, finding the accounts, etc but providing each of the accounts into a dialog box titled "windows script host" instead of into the body of an email. i dont receive any email, just a series of dialog boxes each containing username, display name and date of a single account. let me know if i'm not making sense.
0
 
hartwellcorpAuthor Commented:
oh, then the last dialog box is actually permission denied on line 73, char 1. i'll run this script again from a server which has permission to send smtp mail anonymously.
0
 
hartwellcorpAuthor Commented:
okay if i run it on a server which can send email i get all the same dialog boxes with account info and then i get an error "file not found" on line 75, char 1. no email comes but also no error about send email either.
0
 
yo_beeDirector of Information TechnologyCommented:
You need to run it from a cmd line using cscript "filename.vbs"
Did you put the proper e-mail server name in line 121.
Are you running this from a 2008 or 2003 server.
0
 
hartwellcorpAuthor Commented:
Win Server 2003. ran it again from a cmd prompt and same error file not found <75,1>
0
 
hartwellcorpAuthor Commented:
it worked! awesome! i just had to fill in the subject and body of the message. however, it's sending the text file as a attachment. My goal was to send the info in the body of the message. is that possible?
0
 
yo_beeDirector of Information TechnologyCommented:
That is easy to fix. I thought it would be nice as an attachment.
Let me tweak the script.
0
 
hartwellcorpAuthor Commented:
oh, this is very nice. all formatted and everyting. nice! thank you!
0
 
yo_beeDirector of Information TechnologyCommented:
Just an FYI.
I am thankful for the awarded points, but these types of questions should be worth more.
There is some work that needed to go into this.

Now you can schedule this to run daily, weekly, monthly for automation.
Enjoy.
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.