Question

我有一个工作簿，我可以根据一系列单元格创建PDF。一切正常。我这样做是为了生成电子邮件，因此可以在电子邮件之前进行检查。然后，我从同一个工作簿创建一个电子邮件，随附PDF。电子邮件的正文是从工作簿中的另一个单元格创建的。再说一次，没有问题。我发送问题时出现了问题。电子邮件发送正常，电子邮件的正文很好，但没有附件。

我已经尝试过三重检查附件的文件路径（甚至将其移动到更简单的路径进行测试）并更改它以附加一个简单的word文档。我还使用了两个不同的电子邮件提供商1＆amp; 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，而不是Attachments.Add（后者适用于MS Outlook）。您的方法调用可能还有其他错误，因此我的建议仍然存在：debug without On Error Resume Next

来自Excel的电子邮件不会发送附件

1 个答案: