visualbasic Archives

outlook내 icloud내 연락처의 표시방법 변경

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

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

Set objOL = Nothing

Set objNS = Nothing

Set obj = Nothing

Set objContact = Nothing

Set objItems = Nothing

Set objICloudFolder = Nothing

Set objICloudContacts = Nothing

End Sub

anydragon

참고자료

최신 글

보관함

outlook내 icloud내 연락처의 표시방법 변경

태그

링크

메타