Need help modify vbs script - Active Directory

• 2012年2月16日 17:25

   

   
  

  0

  Hello all,

  The script below design to search for users that thier password is about to expire and send them an email notification.

  The issue is that when the script hit a user that does not have an email address it brakes.

  I would like to modify it so it will ignore any users that do not have email address or hidden computer account that might be seen as users (class user).

  Any help will be highly appriciated.

  TIA,

  Tom

  Option Explicit
  
  
  Dim objCommand, objConnection, objChild, objUserConnection, strBase, strFilter, strAttributes, strPasswordChangeDate, intPassAge
  Dim lngTZBias, objPwdLastSet, strEmailAddress, objMessage
  Dim objShell, lngBiasKey, k, PasswordExpiry, strRootDomain
  Dim strQuery, objRecordset, strName, strCN, strDN
  Dim app, folder, file
  
  
  ' ********************* CHANGE THESE VALUES TO PASSWORD EXPIRY AND ROOT OF WHERE USERS WILL BE SEARCHED ***********************************
  
  
  PasswordExpiry=89
  strRootDomain="dc=xxx,dc=com"
  
  
  ' *****************************************************************************************************************************************
  
  
  
  
  ' 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)) = "VARIANT()" Then
    lngTZBias = 0
    For k = 0 To UBound(lngBiasKey)
      lngTZBias = lngTZBias + (lngBiasKey(k) * 256^k)
    Next
  End If
  
  
  Set objCommand = CreateObject("ADODB.Command")
  Set objConnection = CreateObject("ADODB.Connection")
  objConnection.Provider = "ADsDSOObject"
  objConnection.Open "Active Directory Provider"
  objCommand.ActiveConnection = objConnection
  strBase = "<LDAP://" & strRootDomain & ">"
  
  
  'strFilter = "(&(objectCategory=person)(objectClass=user))"
  ' Below string from comments on web page where script came from
  ' changed to not include disabled accounts and accts set to non-expiry
  strFilter = "(&(objectCategory=person)(objectClass=user)(!userAccountControl:1.2.840.113556.1.4.803:=2)(!userAccountControl:1.2.840.113556.1.4.803:=65536))"
  strAttributes = "sAMAccountName,cn,mail,pwdLastSet,distinguishedName"
  strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
  objCommand.CommandText = strQuery
  objCommand.Properties("Page Size") = 100
  objCommand.Properties("Timeout") = 30
  objCommand.Properties("Cache Results") = False
  Set objRecordSet = objCommand.Execute
  
  
  ' WScript.echo "Running at " & Date()
  
  
  Do Until objRecordSet.EOF
    strName = objRecordSet.Fields("sAMAccountName").Value
    strCN = objRecordSet.Fields("cn").value
    strDN = objRecordSet.Fields("distinguishedName").value
    strEmailAddress = objRecordSet.Fields("mail").value
    Wscript.Echo "NT Name: " & strName & ", Common Name: " & strCN & ", DN: " & strDN
  
  
    Set objUserConnection = GetObject("LDAP://" & objRecordSet.Fields("distinguishedName").Value)
    Set objPwdLastSet = objUserConnection.pwdLastSet
    strPasswordChangeDate = Integer8Date(objPwdLastSet, lngTZBias)
    WScript.Echo vbTab & "Password last changed at " & strPasswordChangeDate
    intPassAge = DateDiff("d", strPasswordChangeDate, Now)
    WScript.Echo vbTab & "Password changed " & intPassAge & " days ago"
  
  
    If intPassAge = (PasswordExpiry-0) Then
      WScript.echo vbTab & "Sending user notification to " & strEmailAddress & " that password expires in 0 days"
      Call SendEmailMessage(strEmailAddress, 0)
    ElseIf intPassAge = (PasswordExpiry-1) Then
      WScript.echo vbTab & "Sending user notification to " & strEmailAddress & " that password expires in 1 days"
      Call SendEmailMessage(strEmailAddress, 1)
    ElseIf intPassAge = (PasswordExpiry-2) Then
      WScript.echo vbTab & "Sending user notification to " & strEmailAddress & " that password expires in 2 days"
      Call SendEmailMessage(strEmailAddress, 2)
    ElseIf intPassAge = (PasswordExpiry-3) Then
      WScript.echo vbTab & "Sending user notification to " & strEmailAddress & " that password expires in 3 days"
      Call SendEmailMessage(strEmailAddress, 3)
    ElseIf intPassAge = (PasswordExpiry-4) Then
      WScript.echo vbTab & "Sending user notification to " & strEmailAddress & " that password expires in 4 days"
      Call SendEmailMessage(strEmailAddress, 4)
    ElseIf intPassAge = (PasswordExpiry-5) Then
      WScript.echo vbTab & "Sending user notification to " & strEmailAddress & " that password expires in 5 days"
      Call SendEmailMessage(strEmailAddress, 5)
    ElseIf intPassAge = (PasswordExpiry-10) Then
      WScript.echo vbTab & "Sending user notification to " & strEmailAddress & " that password expires in 10 days"
      Call SendEmailMessage(strEmailAddress, 10)
    ElseIf intPassAge > (90) Then
      WScript.echo vbTab & "Sending user notification to " & strEmailAddress & " that password is expired"
      Call SendEmailMessageII(strEmailAddress)
    End If
  
  
    objRecordSet.MoveNext
  Loop
  
  
  objConnection.Close
  
  
  
  
  Function Integer8Date(objDate, 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 overly large
    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
  
  
  Sub SendEmailMessage(strDestEmail, strNoOfDays)
    Set objMessage = CreateObject("CDO.Message")
    objMessage.Subject = "Your xxx Password will expire in " & strNoOfDays & " days"
    objMessage.Sender = "Helpdesk <helpdesk@xxx.com>"
    objMessage.To = strDestEmail
    objMessage.Cc = "test@xxx.com"
    objMessage.TextBody = "****URGENT !****" & vbcrlf &" "& vbcrlf & "This email is an automated email informing you that your xxx password will expire in " & strNoOfDays & " days." & vbcrlf & " "& vbcrlf & "1. If you have a xxx computer, please ensure that you change your password before it expires by pressing 'Ctrl+Alt+Delete' and choosing 'Change Password' on your xxx laptop. If you are outside the office, you must connect to the VPN to when changing your password." & vbcrlf &" "& vbcrlf & "2. Click Alt+Ctrl+Del and select Change Password." & vbcrlf &" "& vbcrlf & "3. If you are using an Active Sync device (such as an iPAD), please remember to update your device with the new password in Active Sync (Start, Active Sync, Menu, Configure server)." & vbcrlf &" "& vbcrlf & "If you require assistance, please contact the xxx Service Desk at xxx-xxx-xxxx or at helpdesk@sigmatau.com" & vbcrlf & " "
   
    objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing")=2
    objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver")="192.168.x.x"
    objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport")=26
    objMessage.Configuration.Fields.Update
  
  
    objMessage.Send
  End Sub
  
  
  
  
  Sub SendEmailMessageII(strDestEmail)
    Set objMessage = CreateObject("CDO.Message")
    objMessage.Subject = "Your xxx Password IS EXPIRED"
    objMessage.Sender = "xxx Tech Support <xxx@xxxx.com>"
    objMessage.To = strDestEmail
    objMessage.Cc = "xxx@xxx.com"
    objMessage.TextBody = "****URGENT !****" & vbcrlf &" "& vbcrlf & "This email is an automated email informing you that your xxx password is expired." & vbcrlf & " "& vbcrlf & "1. If you have a xxx computer, please ensure that you change your password before it expires by pressing 'Ctrl+Alt+Delete' and choosing 'Change Password' on your xxx laptop. If you are outside the  office, you must connect to the xxx SonicWall NetExtender when changing your password." & vbcrlf &" "& vbcrlf & "2. If you only use SharePoint or Outlook Web Access, please log into https://mail.xxx.com/owa and choose Options, Change Password." & vbcrlf &" "& vbcrlf & "3. If you are using an Active Sync device (such as an iPAD), pllease remember to update your xxx mobile device with the new password in Active Sync (Start, Active Sync, Menu, Configure server)." & vbcrlf &" "& vbcrlf & "If you require assistance, please contact the xxx Service Desk at xxx-xxx-xxxx or at xxx@xxx.com" & vbcrlf & " "
  
  
    objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing")=2
    objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver")="192.168.x.x"
    objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport")=26
    objMessage.Configuration.Fields.Update
  
  
    objMessage.Send
  End Sub
  
  

  • 返信
  • 引用