发送电子邮件不起作用的VBScript,错误代码0x80040217?

时间:2015-05-14 19:13:37

标签: email vbscript smtp google-apps

我有以下VB脚本在从Gmail帐户发送电子邮件时工作正常。但是,我想从使用Google Apps帐户的公司帐户发送电子邮件。我不确定我是否应该在这段代码中使用SMTP服务器,如果是这样的话;它应该是什么?

Const cdoSendUsingPickup = 1 'Send message using the local SMTP service pickup directory. 
Const cdoSendUsingPort = 2 'Send the message using the network (SMTP over the network). 

Const cdoAnonymous = 0 'Do not authenticate
Const cdoBasic = 1 'basic (clear-text) authentication
Const cdoNTLM = 2 'NTLM

Set objMessage = CreateObject("CDO.Message") 
objMessage.Subject = "This is a test!" 
objMessage.From = "dummy1@somecorp.com" 
objMessage.To = "dummy2@somecorp.com" 
'objMessage.TextBody = "This is some sample message text.." & vbCRLF & "It was sent using SMTP authentication and SSL."
objMessage.HTMLBody = "<h1>This is some sample message in html.</h1><br/><h2>Just to test HTML elements if they're working or not.</h2>" 
'==This section provides the configuration information for the remote SMTP server.

objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 

'Name or IP of Remote SMTP Server
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"

'Type of authentication, NONE, Basic (Base64 encoded), NTLM
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = cdoBasic

'Your UserID on the SMTP server
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusername") = "dummy1@somecorp.com"

'Your password on the SMTP server
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "password"

'Server port 
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465 

'Use SSL for the connection (False or True)
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True

'Connection Timeout in seconds (the maximum time CDO will try to establish a connection to the SMTP server)
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60

objMessage.Configuration.Fields.Update

'==End remote SMTP server configuration section==

objMessage.Send
msgbox "Done:)"

1 个答案:

答案 0 :(得分:2)

Gmail用户可以在官方网站上访问其帐户,也可以使用第一方或第三方应用和服务。第一方应用程序是Google的Android官方Gmail应用程序,而Thunderbird和Windows 8的邮件客户端应用程序是第三方应用程序。

Google announced早在2014年4月,它将改善其服务的登录安全性,并影响向公司发送用户名和密码的任何应用程序。

该公司建议当时切换到OAuth 2.0,但直到现在才强制执行。

如果您在Google上的安全设置下打开新的less secure应用页面,您会发现Google默认禁用了访问权限。

注意:只有在您未使用Google Apps或已为该帐户启用双因素身份验证时才能看到该页面。

您可以在此处翻转开关以再次启用安全性较低的应用程序,以便重新获得访问权限。

enter image description here

试试这个适用于我的vbscript,并告诉我你是否遇到过一些问题。

EmailSubject = "Sending Email by CDO"
EmailBody = "This is the body of a message sent via" & vbCRLF & _
        "a CDO.Message object using SMTP authentication ,with port 465."

Const EmailFrom = "self@gmail.com"
Const EmailFromName = "My Very Own Name"
Const EmailTo = "someone@destination.com"
Const SMTPServer = "smtp.gmail.com"
Const SMTPLogon = "self@gmail.com"
Const SMTPPassword = "gMaIlPaSsWoRd"
Const SMTPSSL = True
Const SMTPPort = 465

Const cdoSendUsingPickup = 1    'Send message using local SMTP service pickup directory.
Const cdoSendUsingPort = 2  'Send the message using SMTP over TCP/IP networking.

Const cdoAnonymous = 0  ' No authentication
Const cdoBasic = 1  ' BASIC clear text authentication
Const cdoNTLM = 2   ' NTLM, Microsoft proprietary authentication

' First, create the message

Set objMessage = CreateObject("CDO.Message")
objMessage.Subject = EmailSubject
objMessage.From = """" & EmailFromName & """ <" & EmailFrom & ">"
objMessage.To = EmailTo
objMessage.TextBody = EmailBody

' Second, configure the server

objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2

objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserver") = SMTPServer

objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = cdoBasic

objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusername") = SMTPLogon

objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendpassword") = SMTPPassword

objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = SMTPPort

objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = SMTPSSL

objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60

objMessage.Configuration.Fields.Update
'Now send the message!
On Error Resume Next
objMessage.Send

If Err.Number <> 0 Then
    MsgBox Err.Description,16,"Error Sending Mail"
Else 
    MsgBox "Mail was successfully sent !",64,"Information"
End If