title: VBA-Trouble with attaching cells into body of email(Outlook)
body: <p>I am using excel 2003 and I am having trouble attaching cells onto the body of an email. I got some of the code off <a href="http://www.rondebruin.nl/mail/folder3/mail4.htm" rel="nofollow noreferrer">http://www.rondebruin.nl/mail/folder3/mail4.htm</a> but it does not work for me. What happens to me is that a spreadsheet would pop up that has Not Peer Review on it and an error message saying "runtime error '1004' PasteSpecial method of Range class failed". Please provide assistance.</p>
  
  <p>Below is the code (the code in bold is the error):  </p>
  
  <pre><code>'' Creates Email  
  
  Sub Email_Click()  
  Dim sDate As Date  
  sDate = ThisWorkbook.Sheets("SheetA").Range("H4").Value  
  
  Dim olApp As Outlook.Application  
  Dim olMail As MailItem  
  Dim tmp  
  Set olApp = New Outlook.Application  
  
  '' Location of email template  
  Set olMail = olApp.CreateItem(olMailItem)  
  ThisWorkbook.Worksheets("SheetB").Activate  
  Application.ActiveSheet.Columns("A:E").AutoFit  
  
  Dim totalRows As Integer
  totalRows = Application.ActiveSheet.UsedRange.Rows.count  
  
  With olMail  
  '' Subject  
  .Subject = "Email"   
  .BodyFormat = olFormatHTML  
  .To = "emailsheet@gmail.com"  
  
  '' Body  
  .HTMLBody = RangetoHTML(Application.ActiveSheet.Range("A1:E" &amp; totalRows))   
  .Display  
  
  End With  
  Set olMail = Nothing  
  Set olApp = Nothing  
  ThisWorkbook.Worksheets("Base Sheet").Activate  
  
  End Sub 
  </code></pre>
  
  <p><br>
  <br></p>
  
  <pre><code>Function RangetoHTML(rng As Range)  
  '' Changed by Ron de Bruin 28-Oct-2006  
  '' Working in Office 2000-2007  
  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>