"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?!

ThanksStart Free Trial