Sub 표시방법변경()
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 objICloudFolder As Outlook.MAPIFolder
Dim obj As Object
Dim strFirstName As String
Dim strLastName As String
Dim strName As String
On Error Resume Next
Set objOL = CreateObject("Outlook.Application")
Set objNS = objOL.GetNamespace("MAPI")
Set objICloudFolder = objNS.Folders("iCloud")
Set objICloudContacts = objICloudFolder.Folders("연락처")
Set objItems = objICloudContacts.Items
For Each obj In objItems
If obj.Class = olContact Then
Set objContact = obj
With objContact
strFirstName = .FirstName
strLastName = .LastName
If (.FirstName <> "" And .LastName <> "") Then
.FullName = .LastName + .FirstName
End If
If (strLastName = "" And strFirstName = "") Then
strName = .CompanyName
Else
strName = strLastName + strFirstName
End If
If (.JobTitle <> "인턴") Then
.FileAs = strName + IIf(.JobTitle <> "" And .FirstName <> "", " " + .JobTitle + "님", " 님")
Else
.FileAs = strName + " 님"
End If
If (.Email1Address <> "" And strName <> "") Then
.Email1DisplayName = .FileAs
End If
If (.Email2Address <> "" And strName <> "") Then
.Email2DisplayName = .FileAs
End If
If (.Email3Address <> "" And strName <> "") Then
.Email3DisplayName = .FileAs
End If
.Save
End With
End If
Err.Clear
Next
Set objOL = Nothing
Set objNS = Nothing
Set obj = Nothing
Set objContact = Nothing
Set objItems = Nothing
Set objICloudFolder = Nothing
Set objICloudContacts = Nothing
End Sub
