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=c om"
' ************************** ********** ********** ********** ********** ********** ********** ********** ********** ********** ********** ********** *
' Obtain local Time Zone bias from machine registry.
Set objShell = CreateObject("Wscript.Shel l")
lngBiasKey = objShell.RegRead("HKLM\Sys tem\Curren tControlSe t\Control\ TimeZoneIn formation\ ActiveTime Bias")
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.Comman d")
Set objConnection = CreateObject("ADODB.Connec tion")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
objCommand.ActiveConnectio n = objConnection
strBase = "<LDAP://" & strRootDomain & ">"
strFilter = "(&(objectCategory=person) (objectClass=user) (!userAccountControl:1.2.8 40.113556. 1.4.803:=2 ) (!userAccountControl:1.2.8 40.113556. 1.4.803:=6 5536))"
strAttributes = "sAMAccountName,cn,mail,pw dLastSet,d istinguish edName"
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
objCommand.CommandText = strQuery
objCommand.Properties("Pag e Size") = 100
objCommand.Properties("Tim eout") = 30
objCommand.Properties("Cac he Results") = False
Set objRecordSet = objCommand.Execute
' WScript.echo "Running at " & Date()
Do Until objRecordSet.EOF
strName = objRecordSet.Fields("sAMAc countName" ).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("disti nguishedNa me").Value )
Set objPwdLastSet = objUserConnection.pwdLastS et
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(strEmailA ddress, 3)
ElseIf intPassAge = (PasswordExpiry-6) Then
WScript.echo vbTab & "Sending user notification to " & strEmailAddress & " that password expires in 6 days"
Call SendEmailMessage(strEmailA ddress, 6)
ElseIf intPassAge = (PasswordExpiry-9) Then
WScript.echo vbTab & "Sending user notification to " & strEmailAddress & " that password expires in 9 days"
Call SendEmailMessage(strEmailA ddress, 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.F ields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "****.*****.com"
objMessage.Configuration.F ields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objMessage.Configuration.F ields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport")=25
objMessage.Configuration.F ields.Upda te
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
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=**
' **************************
' Obtain local Time Zone bias from machine registry.
Set objShell = CreateObject("Wscript.Shel
lngBiasKey = objShell.RegRead("HKLM\Sys
If UCase(TypeName(lngBiasKey)
lngTZBias = lngBiasKey
ElseIf UCase(TypeName(lngBiasKey)
lngTZBias = 0
For k = 0 To UBound(lngBiasKey)
lngTZBias = lngTZBias + (lngBiasKey(k) * 256^k)
Next
End If
Set objCommand = CreateObject("ADODB.Comman
Set objConnection = CreateObject("ADODB.Connec
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
objCommand.ActiveConnectio
strBase = "<LDAP://" & strRootDomain & ">"
strFilter = "(&(objectCategory=person)
strAttributes = "sAMAccountName,cn,mail,pw
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
objCommand.CommandText = strQuery
objCommand.Properties("Pag
objCommand.Properties("Tim
objCommand.Properties("Cac
Set objRecordSet = objCommand.Execute
' WScript.echo "Running at " & Date()
Do Until objRecordSet.EOF
strName = objRecordSet.Fields("sAMAc
strCN = objRecordSet.Fields("cn").
strEmailAddress = objRecordSet.Fields("mail"
Wscript.Echo "NT Name: " & strName & ", Common Name: " & strCN
Set objUserConnection = GetObject("LDAP://" & objRecordSet.Fields("disti
Set objPwdLastSet = objUserConnection.pwdLastS
strPasswordChangeDate = Integer8Date(objPwdLastSet
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(strEmailA
ElseIf intPassAge = (PasswordExpiry-6) Then
WScript.echo vbTab & "Sending user notification to " & strEmailAddress & " that password expires in 6 days"
Call SendEmailMessage(strEmailA
ElseIf intPassAge = (PasswordExpiry-9) Then
WScript.echo vbTab & "Sending user notification to " & strEmailAddress & " that password expires in 9 days"
Call SendEmailMessage(strEmailA
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.F
objMessage.Configuration.F
objMessage.Configuration.F
objMessage.Configuration.F
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
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
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
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
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
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.Comman d")
Set objConnection = CreateObject("ADODB.Connec tion")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
objCommand.ActiveConnectio n = 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!
after adding the line:
strRootDomain="OU=Users,dc
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.Comman
Set objConnection = CreateObject("ADODB.Connec
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
objCommand.ActiveConnectio
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
If you have the users on the default folder "users", that is not an OU and the string is "CN=users,dc=...,dc=..."
Paulo
ASKER
duh... you are right, I bet that works.
Thanks again!
Thanks again!
Hi, with my code, you were missing strOU in your strBase assignment...
Rob.
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 & ">"
ASKER
You VB dudes are pretty smart! Ive never had such accurate answers so quick.
Thanks for all your help!
Thanks for all your help!
No problem. Thanks for the grade.
Rob.
Rob.
ASKER
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?