[아웃룩] 아웃룩 시작시 특정 기능 수행하는 스크립트

아웃룩을 시작할 때 마다 특정 기능을 수행하는 스크립트이다.

특정 기능 - 정해진 폴더의 메일을 검색하여 보낸 사람 이름을 기준으로 폴더를 생성하고 그 폴더로 메일을 이동

아래의 코드를 ThisOutlookSession에 붙여넣으면 됨.

(outlook2010 기준)

Private Sub Application_Startup()

   Call RuleBySender

End Sub

Sub RuleBySender()

    '보낸 사람으로 폴더를 만들고 거기에 메일 이동

    Dim senderName As String

    Dim folderName As String

    Dim mi As MailItem

    Dim userInbox As MAPIFolder

    

    'MsgBox (TypeName(Session.Folders.Item("아웃룩백업").Folders.Item("받았다 편지함")))

    

    Set userInbox = Session.Folders.Item("아웃룩백업").Folders.Item("받았다 편지함")

    

    

    For jj = 1 To userInbox.items.Count

        

        'Item을 옮기다보면 남은 Item개수와 Item인덱스가 어긋나는 현상이 발생한다.

        '(딱 절반까지 실행 후 인덱스 에러 발생)

        '그래서 Item 개수만큼 반복하되 작업은 항상 첫 번째 Item 가지고 한다.

        If TypeName(userInbox.items.GetFirst) <> "MailItem" Then

            'MsgBox (TypeName(userInbox.Items.Item(jj)))

            'MeetingItem(일정), PostItem(RSS), ReportItem(배달되지 않음)이 나오는 경우가 있다.

            '이 경우 희_기타폴더로 옮긴다

            userInbox.items.GetFirst().Move (userInbox.Folders("[00 기타]"))

            GoTo NextIteration

        End If

        On Error Resume Next

        Set mi = userInbox.items.GetFirst()

        'MsgBox (mi.To)

        senderName = mi.sender.Name

        

        '보낸 사람에 따라 폴더를 합쳐서 보관하기도 하고 개별로 가기도 하고..

        If Right(senderName, 6) = "(JIRA)" Then

            folderName = "[JIRA]"

        ElseIf senderName = "drm@kt.com" Then

            folderName = "[drm@kt.com]"

        ElseIf senderName = "kdap.kt@gmail.com" Then

            folderName = "[kdap.kt@gmail.com]"

        ElseIf Left(senderName, 3) = "그루폰" Then

            folderName = "[00 기타]"

        ElseIf Left(senderName, 3) = "위메프" Then

            folderName = "[00 기타]"

        Else

            folderName = senderName

        End If

        

        boolFolderExist = False

        folderCnt = userInbox.Folders.Count

        For ii = 1 To folderCnt

            If (userInbox.Folders.Item(ii).Name = folderName) Then

                '폴더에 메일 옮기고 루프 탈출

                boolFolderExist = True

                Exit For

            End If

        Next

        

        '폴더가 없다면 폴더 생성

        If boolFolderExist = False Then

            userInbox.Folders.Add (folderName)

        End If

        

        '폴더로 메일 이동

        mi.Move (userInbox.Folders(folderName))

        

NextIteration:

    Next

    

    

    Set userInbox = Nothing

    Set mi = Nothing

    

    If Err.Number > 0 Then

        errStr = "Err source : " + Err.Source + "\n"

        errStr = errStr + "Err Number : " + Err.Number + "\n"

        errStr = errStr + "Err Desc : " + Err.Description

    End If

        

End Sub