使用VBA Excel从Excel发送电子邮件

Question

使用VBA Excel从Excel发送电子邮件

3

我有以下的代码，在单击命令按钮事件下发送邮件：

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

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 = "adbc@adbc.com"
msgOne.from = "bcda@adbc.com"
msgOne.Subject = "Test CDO"
msgOne.TextBody = "It works just fine."
msgOne.Send
End Sub

当我执行此操作时，出现错误：运行时错误-2147220977（8004020f）：自动化错误，此订阅的事件类在无效分区中

msgOne.Send

上述代码在执行时出现了错误。因此，我转而采用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

但是发送时出现了错误，如运行时错误-2147220977（8004020f）：服务器拒绝一个或多个收件人地址。服务器响应为：554 5.7.1：发件人地址被拒绝：访问被拒绝，有时候也会出现运行时错误-'2147220975（80040211）自动化错误

- SaiKiran Mandhala

看看这个有用吗？http://stackoverflow.com/questions/3007270/asp-mail-error-the-event-class-for-this-subscription-is-in-an-invalid-partition - Siddharth Rout

我尝试使用那段代码，但仍然出现相同的错误。 - SaiKiran Mandhala

1个回答

网页内容由stack overflow 提供, 点击上面的

可以查看英文原文，
原文链接

- Nick Perkins · Accepted Answer

如果您注册了CDO类型库，那么您正在使用的代码将适用于VBScript或其他类似语言。该类型库包含属性等，因此您不必使用完整的urn。在VBA中，您必须使用完整的urn。Ron De Bruin在http://www.rondebruin.nl/cdo.htm上提供了一个很好的参考资料。

从他的网站上，您可以看到您的代码与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