Retain attachment when replying

[rrmando]

Hello everyone. First time on here. We are using an automated excel
file that emails itself as an attachment for approvals. Sometimes up to
4 approvals are required. The approver replies to the email and it
continues down the line.

The excel spreadsheet currently copies and pastes itself in the body of
the email because the attachment does not remain with the replies, so
the approver can always refer to the document in the body of the email.
We cannot forward. Is there some VBA code I can use to retain the
attachment with the replies?

I found the code below, but cannot get it to work. I am a rookie with
VBA, so I am either doing something wrong or this code would not work
for what weare trying to do. Any help/suggestions will be greatly
appreciated. Thankyou all in advance.


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

This is the current code I have in the Excel file. I was trying to get
the code above to work with this:

Dim EmailTo As String
Dim oApp As Object
Dim oItem As Object
Dim recipients As String
recipients = "(e-mail address removed)"

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 re
quester separately. Do not reply to this message if you do not approve
it. T
hanks"
...HTMLBody = SheetToHTML(ActiveSheet)
...Importance = 1
...Send
End With
Set oItem = Nothing
Set oApp = Nothing

End Sub



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

 

[Ken Slovak - [MVP - Outlook]]

What doesn't work? What errors are you getting? Do you have a reference set
in your code project for scripting?

 

[Sue Mosher [MVP-Outlook]]

The code you posted is a jumble of bits and pieces that you apparently have not even tried to start connecting. Many of your Subs and Functions have no End Sub or End Function. It's hard to imagine any of it working at all, at least not the way you posted it.

What you want is possible, but not with Outlook VBA code, unless you want to walk around to every machine and copy the code into the Outlook VBA environment for every user and thus give them a new toolbar button that they'd have to remember to use to reply just to these messages (which doesn't seem likely).

Have you thought about building the approval process into macros in the Excel spreadsheet itself? You could use custom properties to stamp the spreadsheet with each successive approver and create a new message, attaching the spreadsheet, to forward it on to the next person in the approval chain.

--
Sue Mosher, Outlook MVP
Author of Configuring Microsoft Outlook 2003

and Microsoft Outlook Programming - Jumpstart for
Administrators, Power Users, and Developers

 

[rrmando]

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 = "(e-mail address removed)"

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

 

[Sue Mosher [MVP-Outlook]]

I think we understood correctly the first time. The code you got wouldn't be applicable at all unless you can use a custom message form, which is an appropriate only in the narrow case where all users use Outlook exclusively as their mail client and either (a) you can publish a form to the Organizational Forms library or (b) you can persuade every user to publish the form to their own Personal Forms library.

That's why I suggested that, since you have a spreadsheet to send around, you might put the "reply" functionality in the spreadsheet itself, so you don't have to delve into Outlook custom forms.
--
Sue Mosher, Outlook MVP
Author of Configuring Microsoft Outlook 2003

and Microsoft Outlook Programming - Jumpstart for
Administrators, Power Users, and Developers

 

[rrmando]

Thank you for the reply. Yes, that is what I would like to do. First
I was not sure if it was possible. Can you provide guidance on the
"reply" functionality to force the attachment to remain with the
replies or to always copy the original sender? Thanks again.

 

[Sue Mosher [MVP-Outlook]]

I'd probably approach it this way:

1) Have the macro that creates the original message with attachment put into custom properties for the worksheet:

-- the address of the original sender (which may or may not be available from Outlook's Namespace.CurrentUser object, depending on your version and configuration)
-- the addresses of the approvers

2) Have a second Approve macro in the spreadsheet that creates a new message, attaches the file, and sends it to the people whose addresses are in the custom properties of the sheet.

3) Put both macros on a toolbar in the worksheet

--
Sue Mosher, Outlook MVP
Author of Configuring Microsoft Outlook 2003

and Microsoft Outlook Programming - Jumpstart for
Administrators, Power Users, and Developers