Link to home
Start Free TrialLog in
Avatar of tgrizzel
tgrizzel

asked on

"Microsoft VBScript runtime error: Type mismatch: 'objMessage.To' " While trying to run script to check and email password age.

I am getting the above error when running my vbs file.

Here is the vbs that I am running:

'
' John Savill 8th June 2005
' Runs check on last password change date
'
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

' ********************* CHANGE THESE VALUES TO PASSWORD EXPIRY AND ROOT OF WHERE USERS WILL BE SEARCHED ***********************************

PasswordExpiry=45
strRootDomain="**=ad,dc=*******,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) (!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
  strEmailAddress = objRecordSet.Fields("mail").value
  Wscript.Echo "NT Name: " & strName & ", Common Name: " & strCN

  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-3) Then
    WScript.echo vbTab & "Sending user notification to " & strEmailAddress & " that password expires in 3 days"
    Call SendEmailMessage(strEmailAddress, 3)
  ElseIf intPassAge = (PasswordExpiry-6) Then
    WScript.echo vbTab & "Sending user notification to " & strEmailAddress & " that password expires in 6 days"
    Call SendEmailMessage(strEmailAddress, 6)
  ElseIf intPassAge = (PasswordExpiry-9) Then
    WScript.echo vbTab & "Sending user notification to " & strEmailAddress & " that password expires in 9 days"
    Call SendEmailMessage(strEmailAddress, 9)
  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 = "Password Expires in " & strNoOfDays & " days"
  objMessage.From = "****@*******.com"
  objMessage.To = strDestEmail
  objMessage.TextBody = "Your password expires in " & strNoOfDays & " days. Please goto https://****.******.com and reset it under the options tab"
  objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "****.*****.com"
  objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
  objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport")=25
  objMessage.Configuration.Fields.Update  

  objMessage.Send
End Sub

This is basically a script that I have found and copied (for the most part).  It seems that there are several other users with the exact same code that have no issues like I do.  If I add my email address in the 'To' field I will receive the emails... however that would make this whole script pointless!  

Can anyone help out here?!

Thanks
ASKER CERTIFIED SOLUTION
Avatar of rodriguesp
rodriguesp
Flag of Portugal image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of tgrizzel
tgrizzel

ASKER

You are the man!

I thought this script was not working at all, right up until minutes after I sent this...then I got an email back from someone saying that they had been getting spammed from me all day!  I did have a user that did not have an email address that this was hanging on.

One other question (wish I could give you extra points for it)  Can I limit this search to just my Users OU?
Hi,

You can limit the search to a specific OU by changing the variable strRootDomain to the ldap path for you OU, for example if you domain is dom.com and you OU is MyUsers, then
strDomainRoot = "OU=MyUsers,dc=dom,dc=com"
Paulo
SOLUTION
Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
SOLUTION
Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Paulo,

after adding the line:

strRootDomain="OU=Users,dc=****,dc=****,dc=com"

I get an error of:  Provider: Table does not exist.

Thanks for the original issues help though!

Rob,

I tried yours:

Set objCommand = CreateObject("ADODB.Command")
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
objCommand.ActiveConnection = objConnection
strOU = "CN=Users,"
strBase = ""

but got an error of a missing variable...I assume this is because strOU was not defined in the Option Explict at the top????  I added that there and this seemed to go.... (this is my VERY first script btw)

Just want to make sure thats correct and Ill say this script is done!

Thanks for all your help!
Hi,

If you have the users on the default folder "users", that is not an OU and the string is "CN=users,dc=...,dc=..."

Paulo
duh... you are right, I bet that works.

Thanks again!
Hi, with my code, you were missing strOU in your strBase assignment...

Rob.
Set objCommand = CreateObject("ADODB.Command")
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
objCommand.ActiveConnection = objConnection
strOU = "CN=Users,"
strBase = "<LDAP://" & strOU & strRootDomain & ">"

Open in new window

You VB dudes are pretty smart!  Ive never had such accurate answers so quick.

Thanks for all your help!
No problem. Thanks for the grade.

Rob.