简体   繁体   English

CDO.message vbscript-传输连接失败

[英]CDO.message vbscript - transport failed to connect

I have a vbscript on a Windows 7 machine in a branch office. 我在分支机构的Windows 7计算机上有一个vbscript。 It works just fine. 它工作正常。 I copied the code to a second branch office Windows 7 machine and I get an error. 我将代码复制到第二个分支机构Windows 7计算机上,但出现错误。 I'm out of ideas. 我没主意了。

Both Windows machines have MS Outlook installed. 两台Windows机器都安装了MS Outlook。

 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 = "x@gmail.com"
email.To = "x@x.com;x@x.com;x@x.com"
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") = "x@gmail.com"
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. Gmail在465上,未指定足够的数量。

Here's working code 这是工作代码

Set emailObj      = CreateObject("CDO.Message")
emailObj.From     = "d@gmail.com"

emailObj.To       = "d@gmail.com"

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"

I have received this error before, and for me it was the security rights between one computer and another. 我以前收到过此错误,对我来说,这是一台计算机与另一台计算机之间的安全权。 it will be worth checking the access rights on the two machines and see if there are differences. 值得检查两台计算机上的访问权限,看看是否存在差异。

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM