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 WithEnd Sub