I have a vbscript on a Windows 7 machine in a branch office. It works just fine. I copied the code to a second branch office Windows 7 machine and I get an error. I'm out of ideas.
Both Windows machines have MS Outlook installed.
Do While asObj.ConnectionState = asCONN_CONNECTED
WeekDayNumber = Weekday(Now())
HourNumber = Hour(Now())
'WScript.Echo asObj.HasData
If asObj.HasData Then
WScript.Echo asObj.ReceiveString
WriteData asObj.ReceiveString
uploadData
CycleDate = Now()
asObj.Sleep 300
Else
If WeekDayNumber > 1 And WeekDayNumber < 7 And HourNumber > 8 And HourNumber < 17 Then
DiffInMinutes = DateDiff("n",CycleDate,Now())
'WScript.Echo "Day=" & WeekDayNumber & vbCrLf & "Hour=" & HourNumber & vbCrLf & "cycle=" & CycleDate & vbCrLf & "diff=" & DiffInMinutes & vbCrLf & " Now=" & Now()
If DiffInMinutes > 2 Then
SendAlertEmail
WriteData "Alert email sent " & Now() & vbCrLf
WScript.Echo cyclecounter & " no data"
CycleDate = Now()
' Sleep 5 minutes
asObj.Sleep 1000
End If
End If
End If
Loop
' And finally, disconnect
WScript.Echo "Disconnect -- we should never get to this point. Call Chris!"
asObj.Disconnect
Else
WScript.Echo "bad connection. You have to restart the script"
End If
Sub WriteData(sData)
Const ForAppending = 8
Const OutputFile = "d:\calldata\calldata_data\CallData_$DATE$mtp.txt"
Dim DateNow
Dim varDate
Dim objFile
Dim objFSO
' WScript.Echo sData
Datenow = Date()
varDate = Year(DateNow) & Right("0" & Month(DateNow), 2) & Right("0" & Day(DateNow), 2)
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(Replace(OutputFile, "$DATE$", varDate), ForAppending, True)
objFile.WriteLine sData
objFile.Close
Set objFile = Nothing
Set objFSO = Nothing
End Sub
Sub uploadData
Dim objShell
Set objShell = Wscript.CreateObject("WScript.Shell")
objShell.Run "c:\calldata\FTPupload.vbs",10,True
objShell.Run "c:\calldata\updateCallData.vbs",10,True
' Using Set is mandatory
Set objShell = Nothing
End Sub
Sub SendAlertEmail
Set email = CreateObject("CDO.Message")
WScript.Echo "step 1"
email.Subject = "MTP - Possible phone time collection failure"
email.From = "[email protected]"
email.To = "[email protected];[email protected];[email protected]"
email.TextBody = Now() & " The collection of phone time that is done on the MTP Domain Controller seems to have failed. There has been no data for quite a while."
email.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1 'basic (clear-text) authentication
email.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "[email protected]"
email.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "password"
email.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing")=2
email.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver")="smtp.gmail.com"
email.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport")=25
email.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = 1
email.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 30
email.Configuration.Fields.Update
email.Send
If Err Then
WScript.Echo "SendMail Failed:" & Err.Description
End If
set email = Nothing
'WScript.Echo"step 2"
End Sub
Gmail is on 465 and not enough is specified.
Here's working code
Set emailObj = CreateObject("CDO.Message")
emailObj.From = "[email protected]"
emailObj.To = "[email protected]"
emailObj.Subject = "Test CDO"
emailObj.TextBody = "Test CDO"
emailObj.AddAttachment "c:\windows\win.ini"
Set emailConfig = emailObj.Configuration
emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = true
emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/sendusername") = "d"
emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "Password1"
emailConfig.Fields.Update
emailObj.Send
If err.number = 0 then Msgbox "Done"