Как отправить e-mail через VBA без Outlook

Question

Я пытаюсь отправить электронную почту через SMTP в VBA, но возвращает ошибку.

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)

Описание

Ошибка: транспорт не удалось подключиться к серверу

Answer 1

Вы можете попробовать следующее, но не забудьте поставить галочку флажок «Microsoft CDO для библиотеки Windows 2000»

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