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 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 objContactsFolder = objNS.GetDefaultFolder(olFolderContacts)
Set objItems = objContactsFolder.Items

For Each obj In objItems
If obj.Class = olContact Then
Set objContact = obj

With objContact
strFirstName = .FirstName
strLastName = .LastName

If (strLastName = "" Or strFirstName = "") Then
    strName = .CompanyName
Else
    strName = strLastName + strFirstName
End If

.FileAs = strName + IIf(.JobTitle <> "", " " + .JobTitle + "님", "")

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

If (.FirstName <> "" And .LastName <> "") Then
    .FullName = .LastName + .FirstName
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 objContactsFolder = Nothing

End Sub

크리에이티브 커먼즈 라이센스

이 저작물은 크리에이티브 커먼즈 코리아 저작자표시-비영리-변경금지 2.0 대한민국 라이센스에 따라 이용하실 수 있습니다.

(0) (0)