Pfthb

I have a macro to send out a daily email. It was mostly a copy paste from a website and worked before, however now I have some shapes in the range that I want included in the email. I'm sure there is something glaring that I am missing and I already tried quite a few things to get it to work with no luck.

Here is the first part that seems to be fine.

Sub Send_EOS()

Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object

Set rng = Nothing
On Error Resume Next

Set rng = Sheets("Wash").Range("B2:H98").SpecialCells(xlCellTypeVisible)

On Error GoTo 0

If rng Is Nothing Then
 MsgBox "The selection is not a range or the sheet is protected" & _
 vbNewLine & "please correct and try again.", vbOKOnly
 Exit Sub
End If

With Application
 .EnableEvents = False
 .ScreenUpdating = False
End With

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail
 .To = Sheets("Settings").Range("E31")
 .CC = Sheets("Settings").Range("E32")
 .BCC = ""
 .Subject = "" & Sheets("Shift Plan").Range("V3") & " " & Sheets("Shift Plan").Range("V7") & " Shift Wash"
 .HTMLBody = RangetoHTML(rng)
 .send
End With
On Error GoTo 0

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

Set OutMail = Nothing
Set OutApp = Nothing
End Sub

This is where the trouble is. I thought that .DrawingObjects.Delete might be deleting the objects, but removing that didn't fix it. I also thought that the special paste might be doing it and so I changed it to paste all but that didn't work. I also tried no deleting the temp file at the end and not clearing the clipboard to see if something was wrong with the copy, but when I paste it myself the shapes transfer over, but even in the temp file the paste doesn't show the objects. I also tried all of these things together with no luck. I'm a little stuck on this and could use some help. Thanks in advance!

Function RangetoHTML(rng As Range)

Dim fso As Object
Dim ts As Object
Dim TempFile As String
Dim TempWB As Workbook

TempFile = Environ$("temp") & "" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"

rng.Copy
Set TempWB = Workbooks.Add(1)
With TempWB.Sheets(1)
 .Cells(1).PasteSpecial Paste:=8
 .Cells(1).PasteSpecial xlPasteValues, , False, False
 .Cells(1).PasteSpecial xlPasteFormats, , False, False
 .Cells(1).Select
 Application.CutCopyMode = False
 On Error Resume Next
 .DrawingObjects.Visible = True
 .DrawingObjects.Delete
 On Error GoTo 0
End With

With TempWB.PublishObjects.Add( _
 SourceType:=xlSourceRange, _
 Filename:=TempFile, _
 Sheet:=TempWB.Sheets(1).Name, _
 Source:=TempWB.Sheets(1).UsedRange.Address, _
 HtmlType:=xlHtmlStatic)
 .Publish (True)
End With

Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML = ts.ReadAll
ts.Close
RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
 "align=left x:publishsource=")

TempWB.Close savechanges:=False

Kill TempFile

Set ts = Nothing
Set fso = Nothing
Set TempWB = Nothing
End Function