Excel VBA CDO 邮件

Question

我正在尝试使用 Microsoft Office Excel 2007 VBA 代码发送邮件，但出现错误：

Run-time error '-2147220973 (80040213)':

Automation error

我使用的代码是：

Dim cdomsg As Object

Set cdomsg = CreateObject("CDO.message")

With cdomsg.Configuration.Fields

  .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
  .Item("http://schemas.microsoft.com/cdo/configuration/smptserverport") = 25
  .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
  ' .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
  .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "excel.**********@gmail.com"
  .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "**********123"
  ' .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
  .Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
  .Update

End With

With cdomsg

  .Subject = "Automated mail"
  .From = "excel.**********@gmail.com"
  .To = "**********@hitbts.com" ' https://temp-mail.org/
  .TextBody = "Automated mail"
  .AddAttachment ("*:\*****\***********\****************\***********\*****\*****.xlsm")
  .Send

End With

Set cdomsg = Nothing

我试过其他的smpt服务器，当我输入nslookup时cmd中显示的服务器名称和地址，计算机的IP和另一个IP，但我不知道什么是正确的smpt服务器。

回答后编辑：

对于以后搜索此内容的任何人，我使用和工作的代码如下（摘自 this 视频）：

Dim Mail As New Message
Dim Config As Configuration
Set Config = Mail.Configuration

Config(cdoSendUsingMethod) = cdoSendUsingPort
Config(cdoSMTPServer) = "smtp.gmail.com"
Config(cdoSMTPServerPort) = 25
Config(cdoSMTPAuthenticate) = cdoBasic
Config(cdoSMTPUseSSL) = True
Config(cdoSendUserName) = "sender@gmail.com"
Config(cdoSendPassword) = "password123"
Config.Fields.Update

Mail.AddAttachment ("C:\path\file.ext")
Mail.To = "destination@gmail.com"
Mail.From = Config(cdoSendUserName)
Mail.Subject = "Email Subject"
Mail.HTMLBody = "<b>Email Body</b>"

Mail.Send

确保更改 "sender@gmail.com"、"password123"、"C:\path\file.ext" 和 "destination@gmail.com" 以使示例生效，并更改邮件的主题和正文。

我还转到 VBA 的顶部菜单“工具”，选项“参考...”，启用“Microsoft CDO for Windows 2000 Library”并按下 OK，如下所示上面链接的视频。

Direct link to enable the "Less Secure" option for GMail taken from here.

Answer 1

当您使用 Gmail 时；您是否检查过启用 'less secure apps' 是否有所作为？ Support.google.com Reference

Answer 2

呼呼，

我一直在使用与此处讨论的代码类似的代码。它在许多不同的操作系统和 Office/ Excel 版本中都非常可靠。它还在不同国家的不同互联网连接和提供商中可靠地工作。在最近一次去马耳他的旅行中，它无法在我随身携带的两台不同的计算机上运行，它们具有不同的系统和 Office/Excel 版本。我尝试了不同的互联网连接和提供商，但没有成功。
我解决了这个问题，所以我正在分享解决方案，以防它可以帮助将来经过这里的任何人。

简而言之，解决方案是将 smptserverport") = 25 更改为 smptserverport") = 465 （顺便提一下，在我以前的类似编码中，（同时使用我的 gmail.com 电子邮件地址和我的德国电信、t-online.de 电子邮件地址作为发送提供商） 25 或 465。（我一直优先使用 25 而不是 465，仅仅是因为我看到它在类似编码中使用得更频繁））

这是我的解决方案的完整植入，对我来说效果很好。

我已经从这个

更改了我程序的签名行

Sub PetrasDailyProWay1_COM_Way()

因此它现在接受“smptserverport”编号作为其值

Sub PetrasDailyProWay1_COM_Way(ByVal SmptySvrPrt)

任何 Call 我有的例程，例如我有

的这 Call 行

     Application.Run Macro:="'" & ThisWorkbook.Path & "\" & "NeuProAktuelleMakros.xlsm'" & "!ProAktuelleMacrosMtsch.PetrasDailyProWay1_COM_Way"

现在修改为传递值25，因此：

     Application.Run Macro:="'" & ThisWorkbook.Path & "\" & "NeuProAktuelleMakros.xlsm'" & "!ProAktuelleMacrosMtsch.PetrasDailyProWay1_COM_Way" , arg1:="25"

( 上面的代码行运行是过程 Sub PetrasDailyProWay1_COM_Way( ) ，在我的例子中，它位于 Call 行所在的另一个工作簿中。（如果工作簿 "NeuProAktuelleMakros.xlsm" 尚未打开，则由该代码行自动打开 ) )

我现在在我的程序 Sub PetrasDailyProWay1_COM_Way( ) 的末尾添加了错误处理，它安排了该程序的重新运行，如果初始运行，使用 25 ，失败。（这个特殊的解决方案还有一个额外的好处，即我可以自动进行第二次尝试，在这种情况下，在原始编码中，它以前偶尔在第一次尝试时不起作用）

这是我之前的编码结束：

Rem 3 Do it
   .send
   MsgBox Prompt:="Done"
 End With ' CreateObject("CDO.Message") (Rem 1 Library End =======#
End Sub

这是修改后的版本：

Rem 3 Do it initially attempt with  25  ,  then in Malta as well maybe with  465
  On Error GoTo Malta                                                                             ' Intended to catch a possible predicted error in the next line when running the routine in Malta, or/ and an error in the second attempt at a code run                                                                            ' if the next line errors, then I scheduule the routine to run again with  "smtpserverport") = 465
   .send
  On Error GoTo 0
   MsgBox Prompt:="Done (with " & SmptySvrPrt & ")"                                               ' This will typically give either  "Done (with 25)"  or else  "Done (with 465)"  if the routine worked
 End With ' CreateObject("CDO.Message") (Rem 1 Library End =======#
Exit Sub                                                                                          ' Normal routine end for no error exceptional errected situation
Malta:                                                                                                ' Intended to catch a predicted error when running the routine in Malta, or/ and an error in the second attempt at a code run
    If SmptySvrPrt = "465" Then MsgBox Prompt:="Also did not work with  465  , Oh Poo!": Exit Sub ' case error with attempt with  465
 Application.OnTime Now(), "'" & ThisWorkbook.Path & "\" & "NeuProAktuelleMakros.xlsm'" & "!'ProAktuelleMacrosMtsch.PetrasDailyProWay1_COM_Way ""465""'"
' On Error GoTo -1: On Error GoTo 0                                                               ' I do not need this as the  End Sub  will effectively bring down the errection state
End Sub

我在 Application.OnTime 代码行中使用的语法很难理解。（它比我需要的更复杂，但我想保持格式与我的 Call 代码行中使用的格式一致）。

我不知道如何使用 ( ) 括号中的参数来完成 Application.OnTime 代码行的最后一点。我也不知道如何使用我个人更喜欢的命名参数来执行该代码行。如果我调用一个不带参数的过程，我确实设法使用命名参数来做到这一点。但是对于带参数的过程，就像这里新修改的代码一样，我找不到任何有效的语法。因此，如果有人能启发我如何以一种有效的语法，以类似于这种伪形式的形式（那是行不通的）来做那一行，那么我会非常感兴趣。

Application.OnTime EarliestTime:=Now(), Procedure:="'" & ThisWorkbook.Path & "\" & "NeuProAktuelleMakros.xlsm'" & "!'ProAktuelleMacrosMtsch.PetrasDailyProWay1_COM_Way, arg1:=""465""'"

前面已经提到了使用 465 代替 25，以及使用其中一个。我还没有看到任何关于这个“smptserverport”或其他参数到底是什么的解释，至少，以我可以理解的任何形式。如果有人有任何明确的解释，我认为这将是一个有趣的补充。（任何现有解释的链接对我来说都没有用，因为我认为我已经看到了所有这些......我希望它可能是那些没有人能够清楚记录的事情之一，与此同时没有人可以记住它是关于什么的）

ThunkUs : - ) 艾伦

Excel VBA CDO 邮件

Excel VBA CDO Mail

excel

vba

cdo.message