CDO.message vbscript - transport failed to connect

user990016 picture user990016 · May 2, 2014 · Viewed 23.8k times · Source

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

Answer

trigger picture trigger · May 2, 2014

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"