Outlook 제목 변경 script 정리

Motivation

회사에서는 Intranet기반의 웹메일을 사용하고 있다. 회사에서 사용하는 메일시스템은 제한적인 기능만을 제공하는데 특히나 메일 백업을 제대로 지원하지 않아서 아웃룩을 쓰고 있다. 아웃룩을 이용한 일반적인 저장에는 문제가 없지만, 회사 메일로 수발신된 경우에는 아웃룩 헤더가 지원되지 않아 아웃룩에서 제공되는 _대화보기_옵션을 사용할 수 없다. 지원하는 방법이 없을지 고민하던 차에 statckoverflow에서 아래 글을 보고 영감을 얻어서 이를 정리해보고자 한다.

Refer from http://stackoverflow.com/questions/1440233/possible-to-intercept-and-rewrite-email-on-outlook-client-side-using-ironpython

Related Works

아웃룩 메일에서 대화보기 옵션이 동작하는 원리는 아래와 같다.

1. 아웃룩 메일의 대화보기는 ConversationIndex라는 attribute를 기준으로 1차 정렬 된다.
2. ConversationIndex 다음으로는 ConversationTopic으로 대화가 묶인다.
3. 아웃룩으로 수발신을 하지 않으면 ConversationIndex는 임의로 지정되고(확실하지는 않음)
4. ConversationTopic은 Subject, 즉 메일 제목과 동일한 값을 가진다.

회사에서 수발신 되는 메일의 경우는 답변의 경우 Re: 재전송의 경우 Fwd:가 추가되며 메일을 보내는 사람이 임의로 Re: Re:를 Re2:와 같이 형식을 변경하는 경우가 있다.

How to modify?

회사와 같은 메일들을 하나의 대화보기로 묶으려면,

• ConversationIndex는 임의로 맞춰줄 수 없으니 NULL로 초기화
• ConversationTopic에서 Re: Fwd: Re2: 등과 같은 문자열을 삭제하여 원래 메일 제목만 남기도록 변경

신규로 오는 메일에서 정리하고 싶을 때

1. outlook 시작 시에 macro를 실행할 수 있도록 설정
   2010 기준으로 파일 > 옵션 > 보안센터 > 보안센터 설정 > 매크로 설정 > [빨간 박스 2개 중 선택]
2. macro edit실행(outlook에서 Alt + F11) 후
   아래 스크립트 붙여넣기
   

   	Option Explicit
   	Private WithEvents oExpl As Explorer
   	Private WithEvents oItem As MailItem
   	Private bDiscardEvents As Boolean
   	Dim outlookNameSpace As Outlook.NameSpace
   	Dim inbox As Outlook.MAPIFolder
   	Private WithEvents items As Outlook.items
   	Dim WithEvents myInboxMailItem As Outlook.items
   	Public gPattern As String
   	Private Sub oExpl_SelectionChange()
   	On Error Resume Next
   	Set oItem = oExpl.Selection.Item(1)
   	End Sub
   	Public Function change_Subject(ByVal reg As String, origin As String) As String
   	Dim re As New VBScript_RegExp_55.RegExp
   	re.Pattern = reg
   	re.IgnoreCase = False
   	re.Global = True
   	change_Subject = re.Replace(origin, "")
   	End Function
   	Public Function get_reg_count(ByVal reg As String, origin As String) As Long
   	Dim re As New VBScript_RegExp_55.RegExp
   	Dim reCount As New VBScript_RegExp_55.RegExp
   	Dim Count As Long
   	Dim i As Long, j As Long
   	Dim RegMC, RegMC2
   	Dim strTmp As String
   	re.Pattern = reg
   	re.IgnoreCase = False
   	reCount.Pattern = "[0-9]+"
   	Count = 1
   	i = 1
   	Do
   	Set RegMC = re.Execute(origin)
   	j = RegMC.Count
   	If j > 0 Then
   	origin = re.Replace(origin, "")
   	strTmp = RegMC(0).Value
   	Set RegMC2 = reCount.Execute(strTmp)
   	If RegMC2.Count > 0 Then
   	Count = Count + CInt(RegMC2(0).Value)
   	Else
   	Count = Count + 1
   	End If
   	Else
   	Exit Do
   	End If
   	Loop While True
   	get_reg_count = Count
   	End Function
   	Private Sub myInboxMailItem_ItemAdd(ByVal Item As Object)
   	Dim oNS As Object
   	Dim oRDOSess As Object
   	Dim oRDOItem As Object
   	Dim strEntryID As String
   	Dim strStoreID As String
   	Dim objrdoitem As Object
   	Dim S As String
   	Dim strTmp As String
   	Dim newTag As String
   	Dim m As Object
   	Dim strheader As String
   	Dim S_ID As String
   	Dim re As New VBScript_RegExp_55.RegExp
   	Dim tags As MatchCollection
   	Dim tag As Match
   	Dim Full_Categories As String
   	Dim NewConversationTopic As String
   	Dim i As Long, j As Long
   	Set oRDOSess = CreateObject("Redemption.RDOSession")
   	Set oNS = Nothing
   	Set oNS = Outlook.GetNamespace("MAPI")
   	oNS.Logon
   	oRDOSess.MAPIOBJECT = oNS.MAPIOBJECT
   	If Item.UnRead = False Then
   	Exit Sub
   	End If
   	strEntryID = Item.EntryID
   	strStoreID = Item.Parent.StoreID
   	Set objrdoitem = oRDOSess.GetMessageFromID(strEntryID, strStoreID)
   	' Remove Prefix for replay and forward
   	S = change_Subject(gPattern, objrdoitem.Subject)
   	' Trim white space on the head
   	re.Pattern = "^\s+"
   	S = re.Replace(S, "")
   	' Remove [ ]
   	re.Pattern = "\[\s*\]"
   	S = re.Replace(S, "")
   	' Remove [RE]
   	re.Pattern = "\[RE\]"
   	S = re.Replace(S, "")
   	' Remove date format like (1/29)
   	re.Pattern = "\([0-9]+/[0-9]+\)\s*$"
   	S = re.Replace(S, "")
   	'Apply what modifications to topic you want here - dumb example string manipulation shown
   	objrdoitem.ConversationTopic = S
   	objrdoitem.ConversationIndex = 0
   	' Set Category
   	Full_Categories = ""
   	re.Pattern = "\[(.+?)\]"
   	Set m = re.Execute(S)
   	For i = 0 To m.Count - 1
   	For j = 0 To m.Item(i).SubMatches.Count - 1
   	newTag = m.Item(i).SubMatches.Item(j)
   	Full_Categories = newTag + "," + Full_Categories
   	Next
   	Next
   	objrdoitem.Categories = Full_Categories
   	'Call MsgBox(S, vbOKOnly, Full_Categories)
   	objrdoitem.Save
   	'Call MsgBox(S_ID, vbOKOnly, "Good")
   	'Call MsgBox(S, vbOKOnly, objrdoitem.ConversationTopic)
   	End Sub
   	Private Sub Initialize_Handler()
   	Dim fldInbox As Outlook.MAPIFolder
   	Dim gnspNameSpace As Outlook.NameSpace
   	Set gnspNameSpace = Outlook.GetNamespace("MAPI") 'Outlook Object
   	Set fldInbox = gnspNameSpace.GetDefaultFolder(olFolderInbox)
   	Set myInboxMailItem = fldInbox.items
   	End Sub
   	Private Sub Application_Startup()
   	Set oExpl = Application.ActiveExplorer
   	bDiscardEvents = False
   	gPattern = "\b(Re|RE|Fwd|FW|Rq|R)+\s*((:\s*\[[0-9]+\])|(\[[0-9]+\]\s*:)|(:\s*\([0-9]+\))|(\([0-9]+\)\s*:)|(:\s*\^[0-9]+)|(\^[0-9]+\s*:)|(:\s*\*[0-9]+)|(\*[0-9]+\s*:)|:\s*[0-9]+|[0-9]+\s*:|\[[0-9]+\]|\([0-9]+\)|\(\*\)|\*[0-9]+|:)+?\s*"
   	Call Initialize_Handler
   	End Sub

   view raw change_subject.vba hosted with ❤ by GitHub
3. Regular expresssion 사용을 위한 library설정
   도구 > 참조 선택 후 Microsoft VBScript Regular Expressions 5.5 메뉴 선택
4. Outlook에서 대화보기 설정
5. Oulook 재시작

기존에 수신된 메일 정리하기

필요한 파일 다운로드 (python, pywin32, redemption은 최신 버전을 사용해도 무방하다)

1. Python-2.7.5.msi 설치 : http://www.python.org/ftp/python/2.7.5/python-2.7.5.msi
2. pywin32-218.win32-py2.7.exe : http://sourceforge.net/projects/pywin32/files/pywin32/Build%20218/pywin32-218.win32-py2.7.exe/download
3. Redemption DLL설치 (설치가 잘 안 되는 경우 마우스 오른쪽 버튼 > 관리자권한으로 실행) : http://www.dimastr.com/redemption/Redemption.zip