2

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 = "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
user990016
  • 3,208
  • 4
  • 20
  • 29
  • 1
    In cases like this, when it works on one machine but not another, it's rarely a code/script issue. After all, it works on one of them! You'll need to start thinking about the differences between the two computers and start troubleshooting. Are you logged in as the same user on both? Do they have the same Windows updates installed? Are they both 32 or 64-bit? Are there IP or MAC address restrictions on the firewall? Etc, etc. – Bond May 02 '14 at 02:35

2 Answers2

3

Gmail is on 465 and not enough is specified.

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"
trigger
  • 76
  • 1
  • Using 465, I get the following error; Multiple-step OLE DB operations generated errors. Check each OLE DB status value. The line that causes the error is; Set objFile = objFSO.OpenTextFile(Replace(OutputFile, "$DATE$", varDate), ForAppending, True) – user990016 May 02 '14 at 15:51
  • I had to register the cdo.dll and it seems to be working now. – user990016 May 02 '14 at 18:17
1

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.