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

Question

I am trying to send a mail using a vbs script but it doesn't work. I am using server smtp.gmail.com and port 587. The weir thing is that this works when I change the port to 25. Below is the code I am using:

    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

Thank you in advance.

Answer 1

Gmail users can access their account on the official website or by using first-party or third-party apps and services instead. A first party app is for instance Google's official Gmail app for Android, while Thunderbird and the mail client app of Windows 8 are third-party apps.

Google announced back in April 2014 that it would improve the sign-in security of its services and affect any application sending usernames and passwords to the company.

The company suggested to switch to OAuth 2.0 back then but did not enforce it up until now.

If you open the new less secure apps page under security settings on Google, you will notice that Google has disabled access by default.

Note: You see the page only if you are not using Google Apps or have enabled two-factor authentication for the account.

You can flip the switch here to enable less secure applications again so that access is regained.

Another thing the port used is 465 and not 587 So you can try out this vbscript that works for me using the port 465

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