为什么没有附件。从Excel发送电子邮件时要添加工作？

Question

我有一本工作簿，可根据其中的一系列单元格创建PDF。这一切都很好。我与生成电子邮件分开进行此操作，因此可以在通过电子邮件发送之前对其进行检查。然后，我从同一工作簿中创建一个电子邮件，并附带PDF。电子邮件的正文是从工作簿的另一个单元格区域中创建的。同样，这样做没有问题。我发送时出现了问题。电子邮件发送正常，电子邮件正文很好，但没有附件。

我已经对附件的文件路径进行了三重检查（甚至将其移动到更简单的路径进行测试），并对其进行更改以附加简单的Word文档。我还使用了两个不同的电子邮件提供程序1＆1和GMail，但是存在相同的问题。该附件只是不想离开我。

我还注意到，当我将鼠标悬停在任何类型的链接上时，鼠标指针都会显示一条消息。消息是：处理请求时出错-错误的响应。我只能猜测，这与我发出的所有测试电子邮件都有关系，但不知道这意味着什么或如何摆脱它。我有东西还在运行吗？

Sub CDO_Send_Email_Angebot()

    Dim Rng As Range
    Dim iMsg As Object
    Dim ws As Worksheet
    Dim Flds As Variant
    Dim iConf As Object
    Dim PdfFile As String

    PdfFile = Sheets("5_Angebot").Range("E97").Value & "." & Sheets("5_Angebot").Range("E98").Value

    'MsgBox rngAttachment

    '---------- Get the Emails from a cells on the sheet

    Dim SendItTo As String
    Dim SenderEmail As String
    Dim Subjectext As String

    SendItTo = Sheets("5_Angebot").Range("E94").Value
    SenderEmail = Sheets("5_Angebot").Range("E95").Value
    SubjectText = Sheets("5_Angebot").Range("E96").Value

    '---------

    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/smtpusessl") = True
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1

        .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = SenderEmail

        '.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "**********"
        '.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.1and1.com"
        .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "***********"
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"

        .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
        .Update
    End With
    ' ------
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    Set Rng = Nothing
    On Error Resume Next

    Set Rng = Selection.SpecialCells(xlCellTypeVisible)
    Set Rng = Sheets("5_Angebot").Range("C101:J121")

    Set iMsg = CreateObject("CDO.Message")
    With iMsg
        Set .Configuration = iConf
        .To = SendItTo
        .From = SenderEmail
        .Subject = SubjectText

        .HTMLBody = RangetoHTML(Rng)

        '.Attachments.Add PdfFile
        .Attachments.Add ("D:\Corinne\test.docx")
        .Send
    End With
    Set iMsg = Nothing

    ' --------
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With

End Sub

Answer 1

[谷歌快速搜索建议适当的方法是AddAttachment，而不是AddAttachment（后者用于MS Outlook）。您的方法调用中可能还存在其他错误，因此上面的建议仍然存在：debug without Attachments.Add