2009/05/15 02:47

아웃룩 표시 이름 변경 스크립트

PDA를 사용하다보면 이름만 가지고 연락처를 검색하기 힘들 경우가 많이 발생한다. 그런 경우 표시이름에 회사 이름이 들어가 있으면 한결 쉽게 찾을 수 있는데, 아웃룩을 전자메일 클라이언트로 사용하는 경우 이러한 작업을 매크로를 이용해서 할 수 있다.

기본적인 내용은 이전 포스팅을 참조한다.
이 스크립트에서는 표시 이름을
이름 (회사명) 형태로 표시하려는 목적이었다.

실제 코드는 다음과 같다.

' 주소록 표시 이름 정리
Sub makeDisplayName()
    Dim myOlApp As Outlook.Application
    Dim myNms As Outlook.NameSpace
    Dim myFolder As Outlook.MAPIFolder
    Dim myContacts As Outlook.Items
    Dim myContactItem As Outlook.ContactItem
    Dim myContactItemObj As Object
        
    Dim strName As String
    Dim strPath As String
    Dim strPrompt As String

        
    Set myOlApp = CreateObject("Outlook.Application")
        
    Set myNms = myOlApp.GetNamespace("MAPI")
    Set myFolder = myNms.GetDefaultFolder(olFolderContacts)
    Set myContacts = myFolder.Items
    
    For idx = 1 To myContacts.Count
'       Group이 있는 경우 건너뛰기
        Set myContactItemObj = myContacts.Item(idx)
        If myContactItemObj.Class = olContact Then
            Set myContactItem = myContactItemObj
            If myContactItem.LastFirstNoSpace <> "" Then
                If myContactItem.CompanyName <> "" Then
'                   Subject는 연락처 제목 창 표시 정보임.
'                   FileAs는 표시 이름 항목임
                    myContactItem.FileAs = myContactItem.LastFirstNoSpace & " (" & myContactItem.CompanyName & ")"
                End If
             End If
             myContactItem.Save
'            Debug.Print myContactItem.LastFirstNoSpace
            Debug.Print myContactItem.FileAs
         End If
    Next idx
End Sub

마지막으로 매크로를 실행하기 위해서는 도구>매크로>보안 에서 보안 수준을 보통으로 변경해야 한다.
그 다음 매크로를 실행시키면 된다.
저작자 표시 비영리 변경 금지
크리에이티브 커먼즈 라이선스
Creative Commons License
Trackback 0 Comment 0