title: Using VBA to paste range into Outlook does not paste anything
body: <p>I'm trying to automate a report so that it copies a range, pastes it in the body of an email, and sends it.</p>
  
  <p>I'm using the exact code <a href="http://www.rondebruin.nl/win/s1/outlook/bmail2.htm" rel="nofollow">Ron De Bruin</a> gave out, just with my own range entered and a filter statement.</p>
  
  <p>Everything works fine, except when I receive/display the email, it's just a blank email to me. There's no pasted range in it. What I find weird is that this works fine until I filter the range. When I use any kind of filter on it, it breaks and I'm not sure why.</p>
  
  <p>For reference, here is the exact code I'm working with: `  </p>
  
  <pre><code>Sub Mail_Selection_Range_Outlook_Body()
  
      Dim rng As Range
      Dim OutApp As Object
      Dim OutMail As Object
  
      ActiveSheet.Range("A1").AutoFilter Field:=6, Criteria1:="&lt;&gt;"
      ActiveSheet.Range("A1").AutoFilter Field:=1, Criteria1:="Brittany"
  
      Set rng = Nothing
      On Error Resume Next
      'Only the visible cells in the selection
      Set rng = ActiveSheet.Range("A:F").SpecialCells(xlCellTypeVisible)
      rng.Copy
      ActiveSheet.Range("U1").Paste
  
          On Error GoTo 0
  
      If rng Is Nothing Then
          MsgBox "The selection is not a range or the sheet is protected" &amp; _
                 vbNewLine &amp; "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 = "email@email.com"
          .CC = ""
          .BCC = ""
          .Subject = "Test for Updates"
          .HTMLBody = RangetoHTML(rng)
          .Display   'or use .Display
      End With
      On Error GoTo 0
  
      With Application
          .EnableEvents = True
          .ScreenUpdating = True
      End With
  
      Set OutMail = Nothing
      Set OutApp = Nothing
  End Sub
  
  
  
  Function RangetoHTML(rng As Range)
  
      Dim fso As Object
      Dim ts As Object
      Dim TempFile As String
      Dim TempWB As Workbook
  
      TempFile = Environ$("temp") &amp; "\" &amp; Format(Now, "dd-mm-yy h-mm-ss") &amp; ".htm"
  
      'Copy the range and create a new workbook to past the data in
      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
  
      'Publish the sheet to a htm file
      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
  
      'Read all data from the htm file into RangetoHTML
      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=")
  
      'Close TempWB
      TempWB.Close savechanges:=False
  
      'Delete the htm file we used in this function
      Kill TempFile
  
      Set ts = Nothing
      Set fso = Nothing
      Set TempWB = Nothing
  End Function
  </code></pre>
  
  <p>`</p>