Copy and paste 2 excel sheets in message body of email

Hello all. I am using the following code in an excel workbook (it is
automated to email itself as an attachment) that copies and pastes
Sheet1 into the body of an email:

Public Function SheetToHTML(SH As Worksheet)
'Function from **** Kusleika his site
'http://www.*****-clicks.com/excel/sheettohtml.htm
'Changed by Ron de Bruin 04-Nov-2003
Dim TempFile As String
Dim Nwb As Workbook
Dim myshape As Shape
Dim fso As Object
Dim ts As Object
SH.Copy
Set Nwb = ActiveWorkbook
For Each myshape In Nwb.Sheets(1).Shapes
myshape.Delete
Next
TempFile = Environ$("temp") & "/" & _
Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
Nwb.SaveAs TempFile, xlHtml
Nwb.Close False
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
SheetToHTML = ts.ReadAll
ts.Close
Set ts = Nothing
Set fso = Nothing
Set Nwb = Nothing
Kill TempFile
End Function

I am a rookie with VBA. How can I get this code to copy both Sheet1
and Sheet2 into the body of the email? Any ideas/suggestions will be
greatly appreciated. Have a nice day.

Hi rrmando

Use this

.HTMLBody = SheetToHTML(Sheet1) & SheetToHTML(Sheet2)

http://www.rondebruin.nl/mail/folder3/mail2.htm




--
Regards Ron de Bruin
http://www.rondebruin.nl


"rrmando" <[email protected]> wrote in message news:[email protected]...
> Hello all. I am using the following code in an excel workbook (it is
> automated to email itself as an attachment) that copies and pastes
> Sheet1 into the body of an email:
>
> Public Function SheetToHTML(SH As Worksheet)
> 'Function from **** Kusleika his site
> 'http://www.*****-clicks.com/excel/sheettohtml.htm
> 'Changed by Ron de Bruin 04-Nov-2003
> Dim TempFile As String
> Dim Nwb As Workbook
> Dim myshape As Shape
> Dim fso As Object
> Dim ts As Object
> SH.Copy
> Set Nwb = ActiveWorkbook
> For Each myshape In Nwb.Sheets(1).Shapes
> myshape.Delete
> Next
> TempFile = Environ$("temp") & "/" & _
> Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
> Nwb.SaveAs TempFile, xlHtml
> Nwb.Close False
> Set fso = CreateObject("Scripting.FileSystemObject")
> Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
> SheetToHTML = ts.ReadAll
> ts.Close
> Set ts = Nothing
> Set fso = Nothing
> Set Nwb = Nothing
> Kill TempFile
> End Function
>
> I am a rookie with VBA. How can I get this code to copy both Sheet1
> and Sheet2 into the body of the email? Any ideas/suggestions will be
> greatly appreciated. Have a nice day.
>

Thanks for the reply Ron. I'm a big fan of yours by the way I
actually just realized that I was confused. I copied this function on
the sheet, but I am using your code that emails the workbook as an
attachment. I will try it out at the office on Monday.

Can I ask you more more semi-related question? We are using this excel
sheet for an automated purchase approval process. The email created
with this code gets replied to and moves up the ladder of approvers.
Is there any way to get this baby to ALWAYS copy the original sender so
that they know when their purchase has been approved, or so they know
where in the process their purchase requisition is? Thanks again.

Hello again. I have been trying to get

..HTMLBody = SheetToHTML(Sheet1) & SheetToHTML(Sheet2)

to work, but have been unsuccessful. I think I know why. The second
sheet is a Word document that I am inserting via:

Sub Add_Word_Document()
Application.ScreenUpdating = False
Dim MyFile
Sheets.Add After:=Worksheets(Worksheets.Count)
With ActiveWindow
.DisplayGridlines = False
.DisplayHeadings = False
.DisplayOutline = False
.DisplayZeros = False
End With
MyFile = Application.GetOpenFilename(FilterIndex:=5, Title:="Select
the file that you would like to add")
ActiveSheet.OLEObjects.Add(Filename:=(MyFile), Link:=False,
DisplayAsIcon:=False).Select
MyFile = Left(MyFile, Len(MyFile) - 4)
MyFile = Right(MyFile, Len(MyFile) - Len((Left(MyFile,
InStrRev(MyFile, "\")))))
ActiveSheet.Name = "Quote"
Range("A1").Select
Application.ScreenUpdating = True
End Sub

Any way to make the second sheet copy in the body of the email as well?
Thanks.

If you use 2002-2003 you can try the KB on top of my page

--
Regards Ron de Bruin
http://www.rondebruin.nl


"rrmando" <[email protected]> wrote in message news:[email protected]...
> Hello again. I have been trying to get
>
> .HTMLBody = SheetToHTML(Sheet1) & SheetToHTML(Sheet2)
>
> to work, but have been unsuccessful. I think I know why. The second
> sheet is a Word document that I am inserting via:
>
> Sub Add_Word_Document()
> Application.ScreenUpdating = False
> Dim MyFile
> Sheets.Add After:=Worksheets(Worksheets.Count)
> With ActiveWindow
> .DisplayGridlines = False
> .DisplayHeadings = False
> .DisplayOutline = False
> .DisplayZeros = False
> End With
> MyFile = Application.GetOpenFilename(FilterIndex:=5, Title:="Select
> the file that you would like to add")
> ActiveSheet.OLEObjects.Add(Filename:=(MyFile), Link:=False,
> DisplayAsIcon:=False).Select
> MyFile = Left(MyFile, Len(MyFile) - 4)
> MyFile = Right(MyFile, Len(MyFile) - Len((Left(MyFile,
> InStrRev(MyFile, "\")))))
> ActiveSheet.Name = "Quote"
> Range("A1").Select
> Application.ScreenUpdating = True
> End Sub
>
> Any way to make the second sheet copy in the body of the email as well?
> Thanks.
>

Sorry it is not possible to send objects/pictures with my code

--
Regards Ron de Bruin
http://www.rondebruin.nl


"rrmando" <[email protected]> wrote in message news:[email protected]...
> Hello again. I have been trying to get
>
> .HTMLBody = SheetToHTML(Sheet1) & SheetToHTML(Sheet2)
>
> to work, but have been unsuccessful. I think I know why. The second
> sheet is a Word document that I am inserting via:
>
> Sub Add_Word_Document()
> Application.ScreenUpdating = False
> Dim MyFile
> Sheets.Add After:=Worksheets(Worksheets.Count)
> With ActiveWindow
> .DisplayGridlines = False
> .DisplayHeadings = False
> .DisplayOutline = False
> .DisplayZeros = False
> End With
> MyFile = Application.GetOpenFilename(FilterIndex:=5, Title:="Select
> the file that you would like to add")
> ActiveSheet.OLEObjects.Add(Filename:=(MyFile), Link:=False,
> DisplayAsIcon:=False).Select
> MyFile = Left(MyFile, Len(MyFile) - 4)
> MyFile = Right(MyFile, Len(MyFile) - Len((Left(MyFile,
> InStrRev(MyFile, "\")))))
> ActiveSheet.Name = "Quote"
> Range("A1").Select
> Application.ScreenUpdating = True
> End Sub
>
> Any way to make the second sheet copy in the body of the email as well?
> Thanks.
>