如何在没有Outlook的情况下通过VBA发送电子邮件

时间:2017-01-17 12:50:48

标签: vba email smtp

我正在尝试通过VBA中的SMTP发送电子邮件,但是返回错误。

Dim CDOmsg As CDO.Message
Set CDOmsg = New CDO.Message

With CDOmsg.Configuration.Fields
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
    .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "myemail@gmail.com"
    .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "mypass"
    .Item("http://schemas.microsoft.com/cdo/configuration/smptserverport") = 465
    .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 'NTLM method
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
    .Update
End With
' build email parts
With CDOmsg
    .Subject = "the email subject"
    .From = "myemail@gmail.com"
    .To = "mailto@gmail.com"
    .CC = ""
    .BCC = ""
    .TextBody = "the full message body goes here. you may want to create a variable to hold the text"
End With
CDOmsg.Send
Set CDOmsg = Nothing

错误发生在CDOmsg.Send上。我曾尝试使用Gmail和Yahoo Mail发送,但我也遇到了同样的错误。

  

错误代码:-2147220973(80040213)

     

错误说明:传输无法连接到服务器

1 个答案:

答案 0 :(得分:0)

您可以尝试以下操作,但不要忘记勾选“Microsoft CDO for Windows 2000 Library'

Function email(ByVal sender_email As String, _
            ByVal email_message As String, _
            ByVal email_message2 As String, _
            ByVal reply_address As String, _
            ByVal sender_name As String)       

    Dim Mail As New Message

    Dim Cfg As Configuration

    Set Cfg = Mail.Configuration

    'SETUP MAIL CONFIGURATION FIELDS
    Cfg(cdoSendUsingMethod) = cdoSendUsingPort
    Cfg(cdoSMTPServer) = 'SMTP
    Cfg(cdoSMTPServerPort) = 'SMTPport
    Cfg(cdoSMTPAuthenticate) = cdoBasic
    Cfg(cdoSMTPUseSSL) = True
    Cfg(cdoSendUserName) = 'sender_email
    Cfg(cdoSendPassword) = 'password
    Cfg.Fields.Update

    'SEND EMAIL
    With Mail
        .From = 'sender_name & sender_email
        .ReplyTo = 'reply_address
        .To = 'receiver
        .CC = 'carbonCopy
        .BCC = 'blindCopy
        .Subject = 'SubjectLine
        .HTMLBody = 'email_message & email_message2 
        .Attachments.Add attFilePath
        .Send
    End With