【求助】使用cdo发送邮件的时候用STARTTLS方式的安全连接

wuyunxz 2020-05-02 03:47:36

1.以下代码用QQ邮箱连接方式（SSL），465端口可以正常发送邮件；
2.我另外一个邮箱必须用STARTTLS的连接方式，587端口，才能发送邮件。

请问应该如何修改代码，发送STARTTLS验证方式的邮件？

代码如下：

Sub Emailcdo()

    Dim STUl As String

    Dim cdoMail As CDO.Message

    Set cdoMail = New CDO.Message

    STUl = "http://schemas.microsoft.com/cdo/configuration/"

    With cdoMail

        .BodyPart.Charset = "GB2312"

        .from = "xx@xx.com" '发件人邮箱

        .To = "xx@xxx.com" '收件人

        .Subject = "测试邮件" '邮件主题

        .TextBody = "test文本（Text）" '纯文本的邮件内容

        With .Configuration.Fields

            .Item(STUl & "smtpserver") = "xxxxxx" 'SMTP服务器

            .Item(STUl & "smtpserverport") = 587 'SMTP服务器端口

            .Item(STUl & "smtpusessl") = True 'SMTP服务器验证方式

            .Item(STUl & "sendusing") = 2 '使用网络smtp服务器

            .Item(STUl & "smtpauthenticate") = 1 '远程服务器需要验证

            .Item(STUl & "sendusername") = "xx@xx.com" '发送邮箱账号

            .Item(STUl & "sendpassword") = "xxx" '发送邮箱密码

            .Item(STUl & "smtpconnectiontimeout") = 60 '连接超时(秒)

            .Update

        End With

        On Error GoTo err

        .Send

    End With

    MsgBox "邮件发送成功！", 64, "发送成功"

    Set cdoMail = Nothing

    Exit Sub

err:

    Set cdoMail = Nothing

    MsgBox "邮件发送失败" & err.Number & err.Description, 48, "错误提示"

End Sub