Reply All with Attachments

[jason_kelly]

Hi There,

I need your help to modify the code below, such that when the code is executed instead of the attachments appearing at the bottom of the e-mail, to retain their original position in the the reply all e-mail.

Any help with this is greatly appreciated.

Thanks

Jay

Sub ReplyWithAttachments()
Dim rpl As Outlook.MailItem
Dim itm As Object

Set itm = GetCurrentItem()
If Not itm Is Nothing Then
Set rpl = itm.Reply
CopyAttachments itm, rpl
rpl.Display
End If

Set rpl = Nothing
Set itm = Nothing
End Sub
Function GetCurrentItem() As Object
Dim objApp As Outlook.Application

Set objApp = 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
End Select

Set objApp = Nothing
End Function
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

[JP2112]

You'd probably have to parse the message body to see where the attachments are "placed" (not even sure if that is possible), then put them back in the email in the same order. Seems like a lot of trouble. Does it really matter? They're still attached.

FYI if you want the local temp folder, why not use Environ("temp") instead of FSO? The code will be two lines (and one object) shorter.

HTH