无法从 vbs 脚本使用 smtp.gmail.com、端口 587 发送邮件

Question

我正在尝试使用 vbs 脚本发送邮件，但它不起作用。我正在使用服务器 smtp.gmail.com 和端口 587。奇怪的是，当我将端口更改为 25 时它可以工作。下面是我正在使用的代码：

    SMTPMail "to", "cc", "TEST", "TEST"


Function SMTPMail(ByVal sTo, ByVal sCc, ByVal sSubject, ByVal sBody)


    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

    Dim objMessage

    set objMessage = CreateObject("CDO.Message")
    objMessage.Subject = sSubject
    objMessage.Sender = "sender"
    objMessage.From = "from"
    objMessage.To = sTo
    objMessage.CC = sCc
    objMessage.TextBody = sBody


    '==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"    

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

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

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

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

    '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()
    objMessage.Send()

End Function

提前谢谢你。

Answer 1

Gmail 用户可以通过官方网站或使用第一方或第三方应用和服务来访问他们的帐户。第一方应用程序是例如 Google 的 Android 官方 Gmail 应用程序，而 Thunderbird 和 Windows 8 的邮件客户端应用程序是第三方应用程序。

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

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

如果您在 Google 的安全设置下打开新的 less secure 应用页面，您会注意到 Google 默认已禁用访问。

注意：只有当您没有使用 Google Apps 或为帐户启用了双重身份验证时，您才会看到该页面。

您可以在此处拨动开关以再次启用安全性较低的应用程序，从而重新获得访问权限。

另一个使用的端口是 465 而不是 587 因此，您可以使用端口 465

试用适合我的 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