Outlookアドレス帳の表示名

Question

outlookのメール機能で、連絡先（アドレス帳）の自動更新を行うマクロを作成しましたが、連絡先の表示名のみ意図した表示名になりませんでした。

取込用のCSVはA列「電子メール表示名」、B列「名前（※）」、C列「電子メールアドレス」、D列「役職」、E列「所属」とあり、名前等は全てこちらの指示通りに取り込めていますが、A列「電子メール表示名」を連絡先の表示名に反映できず、困っています。

※名前は「氏名_所属_役職」と構成されています。

現在は、連絡先の表示名が「氏名_所属_役職（電子メールアドレス）」になっています。

ただし、マクロを使わず、outlookから直接取込用CSVをインポートした際には、連絡先の表示名はきちんとA列「電子メール表示名」になります。

マクロを使い、連絡先の表示名を取込用CSV　A列「電子メール表示名」にするにはどうすればいいでしょうか。

以下にコードを記載しておきます。※CSVファイル保存先のURLのみ、社内情報のため割愛いたします。

Sub DeleteAndImportContactsFromCSV()
Dim olApp As Object
Dim olNamespace As Object
Dim olFolder As Object
Dim olContact As Object
Dim csvFile As String
Dim csvData As String
Dim arrContacts As Variant
Dim i As Long
Dim objFSO As Object
Dim objFile As Object

' Outlook Application  
Set olApp = CreateObject("Outlook.Application")  
Set olNamespace = olApp.GetNamespace("MAPI")  

' Get Contacts Folder  
Set olFolder = olNamespace.GetDefaultFolder(10) ' 10 is olFolderContacts  

' Delete all contacts from Outlook  
For i = olFolder.Items.Count To 1 Step -1  
    olFolder.Items(i).Delete  
Next i  

' CSV File Path  
csvFile = "URL\新メールアドレス一覧.csv"  

' CSV File Pathの確認  
MsgBox "CSV File Path: " & csvFile  

' Check if CSV file exists  
If FileExists(csvFile) Then  
    ' Read CSV File  
    csvData = ReadFile(csvFile)  

    ' Split CSV Data into Array  
    arrContacts = Split(csvData, vbCrLf)  

    ' Import contacts from CSV  
    For i = LBound(arrContacts) To UBound(arrContacts)  
        ' Create new contact  
        Set olContact = olApp.CreateItem(2) ' olContactItem = 2  

        ' Parse contact details from CSV  
        Dim contactDetails As Variant  
        contactDetails = Split(arrContacts(i), ",")  

        ' Check if the line has the correct number of fields (6 in this case)  
        If UBound(contactDetails) >= 5 Then  
            ' Assign contact details  
            ' LastNameにCSVファイルB列のデータを代入  
            olContact.LastName = contactDetails(1)  
            ' SubjectにCSVファイルのB列のデータを代入  
            olContact.Subject = contactDetails(1)  
            ' Email1DisplayNameにCSVファイルA列のデータを代入  
            olContact.Email1DisplayName = contactDetails(0)  
            olContact.Email1Address = contactDetails(2) ' 電子メールアドレス  
            olContact.JobTitle = contactDetails(3) ' 役職  
            olContact.Department = contactDetails(4) ' 部署  
            olContact.Categories = contactDetails(5) ' 分類  

            ' Save and close the contact  
            olContact.Save  
            Set olContact = Nothing  
        Else  
            ' Skip the line if it doesn't have the correct number of fields  
            MsgBox "CSVファイルの行に誤りがあります: " & arrContacts(i), vbExclamation  
        End If  
    Next i  

    ' Release Outlook objects  
    Set olApp = Nothing  
    Set olNamespace = Nothing  
    Set olFolder = Nothing  

    MsgBox "連絡先を削除し、CSVから新しい連絡先を取り込みました。", vbInformation  
Else  
    MsgBox "CSVファイルが見つかりません。指定されたパスに'新メールアドレス一覧.csv'が存在することを確認してください。", vbExclamation  
End If  

End Sub

Function ReadFile(filePath As String) As String
Dim fileContents As String
Dim objFSO As Object
Dim objFile As Object

Set objFSO = CreateObject("Scripting.FileSystemObject")  
Set objFile = objFSO.OpenTextFile(filePath)  
fileContents = objFile.ReadAll  
objFile.Close  

ReadFile = fileContents  

End Function

Function FileExists(filePath As String) As Boolean
Dim objFSO As Object

Set objFSO = CreateObject("Scripting.FileSystemObject")  
FileExists = objFSO.FileExists(filePath)  

End Function

<モデレーター注>

質問内容をもとにサブカテゴリーを「新しいOutlook」→「従来のOutlook」に変更しました。

適切なカテゴリに投稿すると、返信や回答が得られ易くなり、同じ質問を持つ他のユーザーの参考にもなります。

質問件名(タイトル)を修正させて頂きました。

変更前：outlookのメール機能について

変更後：Outlookアドレス帳の表示名

Answer 1

VBA(マクロ)の公式サポート場所は、海外コミュニティとなっています。

有識者が集まっている所の方が、適切なアドバイスを受けやすいでしょう。

・Stack Overflow(VBA)

　　[VBA プログラミングに関する質問]

　　Stack Overflow には、説明的なタイトル、完全で簡潔な問題ステートメント、問題を再現する
　　ための十分な詳細の要求などのガイドラインがあることに注意してください。
　　機能要求または過度に広範な質問は、トピック外と見なされます。
　　新しいユーザーの場合は、Stack Overflow ヘルプ センター にアクセスして詳細を確認して下さい。

※ 閲覧者・回答者が多い公式サポートサイトをお勧めします。

　 英語で質問を送信してください。

カテゴリー選択されている**「新しいOutlook」が正しければ、マクロはサポートされませんので不可能です**。

Webアドインに組み替えて下さい。

マクロを組むという事は、リファレンスを熟読されていますよね？

Office VBA リファレンス

ContactItemの適切なプロパティに値をセットして下さい。

尚、Exchange環境であればスマホ連携の為にフリガナもセットして方が便利かと思います。

Answer 2

オマケ。

Subject(アドレス帳の名前)：セイメイ

FileAs(アドレス帳の表示名)： 姓名

但し、Save時にOutlookが更にFileAs等を更新してくる場合があるので別途チェックが必要。