VBA Excel-从Excel发送邮件

声明:本页面是StackOverFlow热门问题的中英对照翻译,遵循CC BY-SA 4.0协议,如果您需要使用它,必须同样遵循CC BY-SA许可,注明原文地址和作者信息,同时你必须将它归于原作者(不是我):StackOverFlow 原文地址: http://stackoverflow.com/questions/14250764/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me): StackOverFlow

提示:将鼠标放在中文语句上可以显示对应的英文。显示中英文
时间:2020-09-11 19:07:21  来源:igfitidea点击:

VBA Excel-Sending mail from Excel

excelvba

提问by SaiKiran Mandhala

i have following lines of code to send mail under command button click event.

我有以下代码行在命令按钮单击事件下发送邮件。

Private Sub CommandButton1_Click()
Dim cdoConfig
Dim msgOne

Set cdoConfig = CreateObject("CDO.Configuration")
With cdoConfig.Fields
    .Item(cdoSendUsingMethod) = cdoSendUsingPort
    .Item(cdoSMTPServerPort) = 557  
    .Item(cdoSMTPServer) = "smtp.emailsr.com" 'SMTP server goes here
    '.Item(cdoSendUserName) = "My Username"
    '.Item(cdoSendPassword) = "myPassword"
    .Update
End With

Set msgOne = CreateObject("CDO.Message")
Set msgOne.Configuration = cdoConfig
msgOne.To = "[email protected]"
msgOne.from = "[email protected]"
msgOne.Subject = "Test CDO"
msgOne.TextBody = "It works just fine."
msgOne.Send
End Sub

When i execute this i am facing an error like RunTime Error-2147220977(8004020f): Automation Error The event class for this subscription is in an invalid partition

当我执行此操作时,我面临类似RunTime Error-2147220977(8004020f): Automation Error 此类订阅的事件类位于无效分区中的错误

msgOne.Send

The above line is giving the error during execution. So i moved on to CDO approach for sending an email.Now i am executing following code.

上面的行在执行过程中给出了错误。所以我转而使用 CDO 方法发送电子邮件。现在我正在执行以下代码。

Dim iMsg As Object
Dim iConf As Object
Dim strbody As String
    Dim Flds As Variant

Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")

    iConf.Load -1    ' CDO Source Defaults
    Set Flds = iConf.Fields
    With Flds
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "mysmtpserver.com"
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "mymailId"
        .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "Mypassword"
        .Update

    End With

strbody = "Hi there" & vbNewLine & vbNewLine & _
          "This is line 1" & vbNewLine & _
          "This is line 2" & vbNewLine & _
          "This is line 3" & vbNewLine & _
          "This is line 4"

With iMsg
    Set .Configuration = iConf
    .To = "tomailid"
    .CC = ""
    .BCC = ""
    .From = "mymailid"
    .Subject = "New"
    .TextBody = strbody
    .Send
End With

But Sendis giving me an error like Run-time error -2147220977(8004020f): The server rejected one or more recipient addresses. The server response was: 554 5.7.1 : Sender address rejected: Access deniedAnd some times it is like Runtime Error-'2147220975(80040211)Automation error

但是Send给了我一个错误,比如运行时错误 -2147220977(8004020f):服务器拒绝了一个或多个收件人地址。服务器响应为:554 5.7.1:发件人地址被拒绝:访问被拒绝有时它就像运行时错误-'2147220975(80040211)自动化错误

采纳答案by Nick Perkins

The code you are using would work in VBScript or other similar languages if you registered the CDO Type Library. The type library contains the properties cdoSendUsingMethodetc so that you don't have to use the full urn. In VBA, you have to use the full urn. Ron De Bruin has a good reference about this at http://www.rondebruin.nl/cdo.htm.

如果您注册了 CDO 类型库,则您使用的代码可以在 VBScript 或其他类似语言中运行。类型库包含属性cdoSendUsingMethod等,因此您不必使用完整的骨灰盒。在 VBA 中,您必须使用完整的骨灰盒。Ron De Bruin 在http://www.rondebruin.nl/cdo.htm 上有一个很好的参考资料。

From his site you can see the difference between your code and that required for VBA, specifically here:

从他的网站上,您可以看到您的代码与 VBA 所需的代码之间的区别,特别是在这里:

     Set Flds = iConf.Fields
        With Flds
            .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") _
                           = "Fill in your SMTP server here"
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
            .Update
        End With