Outlook Contacts Field Update....

Exchange ActiveSync를 통해 메일, 연락처, 일정 관리가 가능해 졌다.
메일은 많이 써 왔으니 패스~ 이번엔 연락처 관리 얘기를 한다면...

성과 이름 표시 방법이 제각각이라 연락처 필드 통일(?)이 안되어 한방에 연락처 필드를 업데이트 하는 방법이 필요할 때가 있다.

아웃룩에서  VBA Editor를 띄우고(ALT+F11) 아래 소스를 원하는 대로 수정하여 ThisOutlookSession에 붙이고 실행하면 된다.
혹시 모르니 연락처 백업은 하고 실행을 권한다. ^^;

Public Sub ChangeFileAs() Dim objOL As Outlook.Application Dim objNS As Outlook.NameSpace Dim objContact As Outlook.ContactItem Dim objItems As Outlook.Items Dim objContactsFolder As Outlook.MAPIFolder Dim obj As Object Dim strFirstName As String Dim strLastName As String Dim strFileAs As String On Error Resume Next Set objOL = CreateObject("Outlook.Application") Set objNS = objOL.GetNamespace("MAPI") Set objContactsFolder = objNS.GetDefaultFolder(olFolderContacts) Set objItems = objContactsFolder.Items For Each obj In objItems 'Test for contact and not distribution list If obj.Class = olContact Then Set objContact = obj With objContact ' Uncomment the strFileAs line for the desired format 'Lastname, Firstname (Company) format ' strFileAs = .FullNameAndCompany 'Firstname Lastname format ' strFileAs = .FullName 'Lastname, Firstname format ' strFileAs = .LastNameAndFirstName 'Company name only ' strFileAs = .CompanyName 'Companyname (Lastname, Firstname) ' strFileAs = .CompanyAndFullName .FileAs = strFileAs .Save End With End If Err.Clear Next Set objOL = Nothing Set objNS = Nothing Set obj = Nothing Set objContact = Nothing Set objItems = Nothing Set objContactsFolder = Nothing End Sub