Excel VBA CDO 邮件

Question

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

运行时错误'-2147220973 (80040213)'：

自动化错误

我使用的代码是：

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 库”并按下确定，如上面链接的视频所示。

Direct link 为来自here 的 GMail 启用“不太安全”选项。

Answer 1

当您使用 Gmail 时；您是否检查过启用“不太安全的应用程序”是否有所作为？ Support.google.com Reference

Answer 2

呵呵，

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

简而言之，解决方案是将smptserverport") = 25 更改为smptserverport") = 465 （我顺便注意到，在我以前的类似编码中，（使用我的 gmail.com 电子邮件地址和我的 German Telekom 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 的初始运行失败，则使用 465 安排重新运行该例程的错误处理。 （这个特殊的解决方案有一个额外的优势，我会自动获得第二次尝试，在这种情况下，在原始编码中，它以前偶尔会在第一次尝试时不起作用）

这是我之前的编码结束：

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 : - ) 艾伦