Outlook VBA/宏在回复时删除/移动原始电子邮件
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/11798111/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Outlook VBA/macro to delete/move original email when replied to
提问by RealityShift
At my job we have a ticket system that automatically sends us tickets with the title New Ticket Created: T20120803.0078where the number is generated. We then reply to all with email saying we are working on the ticket. Replies look like this RE: New Ticket Created: T20120803.0072.
在我的工作中，我们有一个票务系统，它会自动向我们发送带有New Ticket Created: T20120803.0078生成编号的标题的票证。然后我们用电子邮件回复所有人，说我们正在处理票证。回复看起来像这样RE: New Ticket Created: T20120803.0072。
My Outlook is set up to forward all tickets into one folder called Tickets. I am trying to figure out how to be able to run a script or macro so that when the email is replied too, it sends both the reply and the original to another folder called InProgress.
我的 Outlook 设置为将所有票证转发到一个名为Tickets. 我试图弄清楚如何能够运行脚本或宏，以便当电子邮件也得到回复时，它将回复和原件发送到另一个名为InProgress.
I went to school for programming but don't have a lot of time to figure this one out. Any help would be greatly appreciated. I assume it's pretty easy. Grab number from subject line and compare to other tickets. If a ticket has a number match, move them.
我去学校学习编程，但没有很多时间来解决这个问题。任何帮助将不胜感激。我认为这很容易。从主题行中获取编号并与其他票证进行比较。如果票证有号码匹配，请移动它们。
回答by Scott Holtzman
don't have a lot of time to figure this one out.
don't have a lot of time to figure this one out.
Typically, at this sight we don't build code for people, but help them build the tweak or perfect code where they are struggling.
通常，在这种情况下，我们不会为人们构建代码，而是帮助他们在他们遇到困难的地方构建调整或完美的代码。
That said, I was intrigued by your question and wanted to learn myself, so I put something together for you. This should get you a great start, if it's not already exactly what you need.
也就是说，我对你的问题很感兴趣，想学习自己，所以我为你整理了一些东西。如果这不是您所需要的，这应该会给您一个良好的开端。
UPDATE:
更新：
You don't even need VBA for the first part. You can set up a rule to move all sent messages with "RE: New Ticket Created"in the subject line to the In Progressfolder. Therefore, you don't even need the whole first IfF Then End Ifblock in the code below. (I've left it for reference, purposes).
第一部分甚至不需要 VBA。您可以设置一个规则，将"RE: New Ticket Created"主题行中的所有已发送邮件移动到In Progress文件夹中。因此，您甚至不需要IfF Then End If下面代码中的整个第一个块。（我把它留作参考，目的）。
CODE
代码
All assumptions based on the settings you provided.
所有假设均基于您提供的设置。
Place the code in the Application_ItemSend event of ThisOutlookSession object in Outlook VBE.
将代码放在 Outlook VBE 中 ThisOutlookSession 对象的 Application_ItemSend 事件中。
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim olNameSpace As Outlook.NameSpace
Set olNameSpace = GetNamespace("MAPI")
Dim olDestFolder As Outlook.Folder
Set olDestFolder = olNameSpace.Folders("[email protected]").Folders("In Progress")
If TypeName(Item) = "MailItem" Then 'if it's a mail item being sent
Dim olMailCopy As Outlook.MailItem
Set olMailCopy = Item.Copy 'copy the item so we can move it and still have it send
If InStr(1, olMailCopy.Subject, "New Ticket Created") > 0 Then '
olMailCopy.Move olDestFolder ' move copy of mail to folder
Dim strTicket As String
strTicket = Mid(olMailCopy.Subject, InStrRev(olMailCopy.Subject, ": ") + 2) 'just grab ticket id
End If
End If
Dim olLookUpFolder As Outlook.Folder
Set olLookUpFolder = olNameSpace.Folders("[email protected]").Folders("Tickets")
Dim olMail As Outlook.MailItem
For Each olMail In olLookUpFolder.Items 'loop through Tickets folder to find original mail
If InStr(1, olMail.Subject, strTicket) > 0 Then 'look for unique ticket Id
olMail.Move olDestFolder ' move to InProgress folder
Exit For
End If
Next
End Sub
