Question

我在分支机构的Windows 7计算机上有一个vbscript。它工作得很好。我将代码复制到第二个分支机构Windows 7机器，我收到一个错误。我没有想法。

两台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

Answer 1

Gmail已启用465，但未指定。

此处的工作代码

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"

Answer 2

之前我收到过这个错误，对我而言，这是一台计算机与另一台计算机之间的安全权利。值得检查两台机器的访问权限，看看是否存在差异。

CDO.message vbscript - 传输无法连接

2 个答案: