Could I lay a new challenge on ya?

Below is some code that allows us to "ReplyAll" *with* original attachments. Our support team needs to do this because we triage, create tickets, and reply to both the sender and the next team with the same ReplyAll message.

It would be greate to integrate this code with the SaveAsMsg code, with an additional tweak.
  • After processing the "ReplyWithAttachments" code to create our container with all original attachments and recipients, would it be possible to kick off the SendAsMsg on the Send message event?
So, once you click "Send" button, the SaveAsMsg would process to create the copy of the sent message and save it to the location selected by the user.
  • *And,* then it would be great if the email in the Sent Items folder could be *moved* to another folder (in this case a folder we have named "*Assigned Tickets").
Here then is the "ReplyWithAttachments" code that we'd like to integrate with the SaveAsMsg code.

[vba]
'<-- BEGIN REPLY WITH ATTACHMENTS -->
Sub ReplyWithAttachments()
' Keyboard Shortcut: Ctrl+w
Dim rpl As Outlook.MailItem
Dim itm As Object
Set itm = GetCurrentItem()
If Not itm Is Nothing Then
Set rpl = itm.ReplyAll
CopyAttachments itm, rpl
rpl.Display
End If

'Application_ItemSend (Item:=itm)
'Call RemoveRecipients(Item:=itm)
Set rpl = Nothing
Set itm = Nothing
End Sub
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
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
'<-- END REPLY WITH ATTACHMENTS -->
[/vba]