Hello. Thank you both for your replies. I obviously did not explain
my situation correctly. The code in my original post is in the Excel
spreadsheet itself. The users open up their spreadsheet, fill out
their purchase request, and they press a button that emails the
spreadsheet as an attachment and makes a copy of Sheet1 in the body of
the email.

Depending on the total dollar amount of a cell in the spreadsheet, the
email gets routed to the appropriate individuals for approval. When
the first approver receives the email, he/she REPLIES to the email and
the reply continues to the next next person in line for approval.
Since the users REPLY to the emails, the attachment (the excel
spreadsheet) is not retained. That is the reason I have it copying and
pasting to the body of the email, so the approvers can reference the
picture of the document if they need to. It would be pretty cool if
the attachment remained with the email every time someone replied to
it, so we wouldn't have to copy and paste into the body of the emial.
It would also print out nicer if it remained an attachment.

Sue, I got this code from a couple of the posts on your website (great
site with lots of good info by the way):

Function GetCurrentItem() As Object
Dim objApp As Outlook.Application

Set objApp = CreateObject("Outlook.Application")
On Error Resume Next
Select Case TypeName(objApp.ActiveWindow)
Case "Explorer"
Set GetCurrentItem =
objApp.ActiveExplorer.Selection.Item(1)
Case "Inspector"
Set GetCurrentItem = objApp.ActiveInspector.CurrentItem
Case Else
' anything else will result in an error, which is
' why we have the error handler above
End Select

Set objApp = Nothing
End Function

Set itm = GetCurrentItem()
Set Reply = itm.ReplyAll

Sub CopyAttachments(objSourceItem, objTargetItem)
Set fso = CreateObject("Scripting.FileSystemObject")
Set fldTemp = fso.GetSpecialFolder(2) ' TemporaryFolder
strPath = fldTemp.Path & "\"
For Each objAtt In objSourceItem.Attachments
strFile = strPath & objAtt.Filename
objAtt.SaveAsFile strFile
objTargetItem.Attachments.Add strFile, , , objAtt.DisplayName
fso.DeleteFile strFile
Next

Set fldTemp = Nothing
Set fso = Nothing
End Sub

I was hoping to somehow adapt it to work with my current excel vba code
to retain the attachment. This is what I currenly use in my excel
sheet (it names and copies itself to the users desktop, emails itself
as an attachment):

Sub PR1()

Dim NewName As String
NewName = Sheets("Sheet1").Range("C8") & " - " & "$" &
Sheets("Sheet1").Range("K43") & ".xls"

Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:= _
"C:\Documents and Settings\All Users\Desktop\" & NewName,
FileFormat _
:=xlNormal, Password:="", WriteResPassword:="",
ReadOnlyRecommended:= _
False, CreateBackup:=False
Application.DisplayAlerts = True

Dim EmailTo As String
Dim oApp As Object
Dim oItem As Object
Dim recipients As String
recipients = "

EmailTo = recipients

Set oApp = CreateObject("Outlook.Application", "localhost")

Set oItem = oApp.CreateItem(0)
With oItem
..To = EmailTo
..Subject = NewName
..Attachments.Add ActiveWorkbook.FullName
..Body = "Please approve this purchase requisition by replying directly
to this email. If you have question about this Req, please email or
call the requester separately. Do not reply to this message if you do
not approve it. Thanks"
..HTMLBody = SheetToHTML(ActiveSheet)
..Importance = 1
..Send
End With
Set oItem = Nothing
Set oApp = Nothing

End Sub

And finally, this is the other code I have in the excel file that makes
a copy of Sheet1 and pastes it in the body of the email:

Public Function SheetToHTML(SH As Worksheet)
'Function from Dick Kusleika his site
'http://www.dicks-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

All I am trying to figure out is if we can force the attached
spreadsheet to stay with the replies all the way through the approval
process. Also, since I have your attention and you are so kind to
answer, is it possible to ALWAYS copy the original sender in all of the
replies that occur? Thank you so much once again for your help.

Armando