Search code examples
excelvbaemailemail-attachments

Why doesn't Attachments.Add work when I send an Email from Excel?


I have a workbook from which I create a PDF based on a range of cells. This all works fine. I do this separately from producing the Email so it can be checked before its Emailed. I then create an Email from the same workbook to send with the PDF attached. The body of the Email is created from a another range of cells from the workbook. Again, no problems with doing that. The problems came when I send it. The Email sends fine and the body of the Email is fine but just without the attachment.

I have triple checked the file path of the attachment (even moving it to a simpler path to test) and change it to attach a simple word document. I have also used two different Email providers 1&1 and GMail but with the same problem. That attachment just does not want to leave me.

I have also noticed that I now have a message appear by the mouse pointer whenever I hover over a link of any kind. The message is : error while processing request - wrong response. I can only guess it has something to do with all the test Emails I have been firing off but no idea what it means or how to get rid of it. Have I something still running?

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

Solution

  • A quick google search suggests the appropriate method is AddAttachment, not Attachments.Add (the latter is for MS Outlook). There may be other errors in your method calls, so my recommendation above still stands: debug without On Error Resume Next