Repeating attachments using MailEnvelope 2010

[Rick Jacobsen]

This is my first post and I'm at a loss on this. I'm using Excel 2010 from which I email regularly and to different people changes in the active sheet. I send both the sheet in the body of the mail as well as in a pdf attachment. Everything works fine with my code with the exception that it repeats the attachments. For instance, I can send the first person an email and it will contain one attachment that matches the body of the email. The next person I send one to will get the correct body in the mail but the attachments will contain both the newer pdf and the older pdf. The pdf attachments continue to stack indefinitely. I need a way to clear those attachments prior to sending the next email. Anyone's help with this is GREATLY appreciated!

Sub Button1_Click()




Dim strPath As String, strFName As String, strFName1 As String, rng As Range
Dim OutApp As Object, OutMail As Object


strPath = Environ$("temp") & "\"

strFName = ActiveWorkbook.Name
strFName = Left(strFName, InStrRev(strFName, ".") - 1) & "_" & ActiveSheet.Name & "_" & ActiveSheet.Range("w7") & ".pdf"

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
strPath & strFName, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False



ActiveWorkbook.EnvelopeVisible = True

With ActiveSheet.MailEnvelope
.Introduction = "Thank you for your quote request. These fees are based on information provided by you. Should this information change the fees reflected herein will be adjusted accordingly." & Chr(13) & Chr(13) & ActiveSheet.Range("AM21") & Chr(13)
.Item.To = "subjectEmail"
.Item.CC = "myemail"
.Item.Subject = "Your Title Quote for" & " " & ActiveSheet.Range("W7")
.Item.Attachments.Add strPath & strFName
.Item.send

End With

Set OutApp = Nothing
Set OutMail = Nothing
Kill strPath & strFName

ActiveSheet.Range("AM21:AW33").ClearContents

End Sub