【VBA】ExcelデータからOutlookの共有の連絡先へ登録/更新する方法！追加フォルダも対応可！

ExcelへまとめたデータからOutlookの共有の連絡先へ一括登録したいときはないでしょうか。

そんな時に悩むことは、

・共有の連絡先の情報を手動で登録することは面倒なので一括登録をしたいが方法がわからない
・Excelにまとめた共有の連絡先一覧をOutlook共有の連絡先へインポートする方法がわからない

ですね。

今回は、

・Excelへまとめたデータを使用してOutlookの共有の連絡先を一括登録する方法
・オプションで共有の連絡先の追加フォルダへ一括登録する方法

についてまとめます。

Excel側の連絡先一覧をOutlookの共有の連絡先へ登録/更新するイメージ

Excel側の連絡先一覧をOutlookの共有の連絡先へ登録/更新するイメージについて説明をします。

Excel側に連絡先データを用意します。

マクロを実行すると、Outlookの共有の連絡先へ一括登録されます。

続いてExcel側の連絡先データの一部を変更し、再度マクロを実行すると、

更新した部分だけOutlookの共有の連絡先が更新されます。

今回の処理フローは以下の通りとなります。

①Excelブック(VBA) →　この連絡先一覧を登録してね　→ Outlook　了解。IDがあれば更新、なければ新規登録するね。
②Excelブック ←　共有の連絡先へ登録/更新したよ。　← Outlook　登録できた。

Outlookの共有の連絡先を更新するにあたり注意すること

Outlookの共有の連絡先のバックアップを行う

Outlookの共有の連絡先を更新する際は必ずバックアップを行い、万が一誤った情報に変わってしまった場合に切り戻しが行えるようにしましょう。

共有元のアドレスのOutlook上にて以下の順で操作をするとcsvファイル形式かPST形式で出力することができますのでご参考ください。

「ファイル」＞「開く/エクスポート」＞「インポート/エクスポート」＞「ファイルにエクスポート」＞「コンマ区切り値」

「ファイル」＞「開く/エクスポート」＞「インポート/エクスポート」＞「ファイルにエクスポート」＞「Outlookデータファイル（PST）」

共有の連絡先を編集できる権限があるか確認する

次にマクロを実行するアカウントに対して共有の連絡先を編集できる権限が付与されているか確認をしましょう。

共有する連絡先フォルダを右クリックします。
「共有」＞「フォルダのアクセス権」をクリックします。
連絡先プロパティの「アクセス権をクリックします。
該当アカウントに対して、書き込みの許可がされているか確認をします。
権限が場合は各書き込み権限にチェックを入れ「OK」を押します。

Excelシートに新規登録する連絡先一覧を用意する

Excelシートに新規登録する連絡先一覧を用意しましょう。

Excelの1シート目がデータ取得の対象となりますので、複数ある場合は1シート目に移動させてください。

次に連絡先データを入力していきます。
項目と入力内容は以下の通りです。

CompanyName	Department	LastName	YomiLastName	FirstName	YomiFirstName	FullName
会社名	部署	姓	姓よみ	名前	名前よみ	フルネーム※空欄

Email1Address	Email1DisplayName	MobileTelephoneNumber	Body(Memo)	EntryID
メールアドレス	メール表示名	携帯番号	メモ	EntryID※空欄

タカヒロ

FullNameとEntryIDはOutlook側で自動生成されますので空欄にしておいてください。

サンプルデータは以下の通りです。

Excel VBAからOutlookを操作するための下準備

①まずExcelを起動し、「開発」タブをクリックします。

②VBEの画面が開いたら、メニューから「ツール」>「参照設定」を選択します。

③「Microsoft Outlook XX.X Object Library」を探してチェックボックスにチェックし「OK」をクリックします。

以上です。

Outlookの共有の連絡先へ登録/更新するVBA

Outlookの共有の連絡先へ登録/更新するVBAを実装していきましょう。

VBAを実装する

サンプルコードは以下の通りとなります。

Sub Outlookの共有の連絡先へ登録_更新する()

    'Outlook用の定義
    Dim olApp As Outlook.Application
    Dim olNamespace As Outlook.Namespace
    Dim olFolder As Outlook.MAPIFolder
    Dim olConItems As Outlook.Items
    Dim olItem As Object
    Dim olItemBefor As Object
    
    'Excel用の定義
    Dim wbBook As Workbook
    Dim wsSheet As Worksheet
    Dim lnContactCount As Long
    
    'スクリーンの更新を行わないようにします。
    Application.ScreenUpdating = False
    
    'Excelのブックとワークシートのオブジェクトを設定します。
    Set wbBook = ThisWorkbook
    Set wsSheet = wbBook.Worksheets(1)

    'Outlookオブジェクトを設定し、MAPI名前空間を介してOutlookの共有の連絡先一覧を取得します。
    Set olApp = New Outlook.Application
    Set olNamespace = olApp.GetNamespace("MAPI")

    '共有の連絡先のアドレスを指定します。
    Set recOther = olNamespace.CreateRecipient("＜共有の連絡先のアドレスを指定＞")
    Set olFolder = olNamespace.GetSharedDefaultFolder(recOther, olFolderContacts)
    Set olConItems = olFolder.Items
            
    '取得結果を記述する行番号を指定します。2行目のセルから開始されることになります。
    lnContactCount = 2
    
    'Excelシートをアクティブにします。
    wsSheet.Activate

    If MsgBox("共有の連絡先を更新しますか？", vbYesNo + vbQuestion, "確認") = vbYes Then

        '共有の連絡先一覧の件数分繰り返す。
        For i = lnContactCount To Cells(1, 3).End(xlDown).Row
            
            'EntryIDの有無を確認します。
            If wsSheet.Cells(i, 12) <> "" Then
                For Each olItemBefor In olConItems
                    '共有の連絡先のEntryIDをキーにして共有の連絡先を検索します。
                    If olItemBefor.EntryID = wsSheet.Cells(i, 12) Then
                        
                        '共有の連絡先のEntryIDと一致していたら、該当アイテムをオブジェクトに設定します。
                        Set olItem = olItemBefor
                        
                    End If
                Next
            Else
                
                'EntryIDがない場合、連絡先オブジェクトを新規作成します。
                Set olItem = olFolder.Items.Add(olContactItem)

            End If

            'アイテムのタイプが連絡先"ContactItem"であるか判定します。
            If TypeName(olItem) = "ContactItem" Then
                    With olItem
                        
                        '連絡先の各項目へ値を代入します。
                        .CompanyName = wsSheet.Cells(i, 1).Value
                        .Department = wsSheet.Cells(i, 2).Value
                        .LastName = wsSheet.Cells(i, 3).Value
                        .YomiLastName = wsSheet.Cells(i, 4).Value
                        .FirstName = wsSheet.Cells(i, 5).Value
                        .YomiFirstName = wsSheet.Cells(i, 6).Value
                        '.FullName = Cells(i, 7) 'フルネームは姓、名より優先的に更新されるため無効化しています。
                        .Email1Address = wsSheet.Cells(i, 8).Value
                        .Email1DisplayName = wsSheet.Cells(i, 9).Value
                        .MobileTelephoneNumber = wsSheet.Cells(i, 10).Value
                        .Body = wsSheet.Cells(i, 11).Value
    
                    End With
                    
                        '連絡先アイテムを保存します。
                        olItem.Save
                    
                    If wsSheet.Cells(i, 12).Value = "" Then

                         '発行されたEntryIDをExcelへ書き込みします。
                         wsSheet.Cells(i, 12).Value = olItem.EntryID
                    
                    End If
            End If
        Next
        
        'スクリーンの更新を行います。
        Application.ScreenUpdating = True
        
        MsgBox "Outlook共有の連絡先の反映が完了しました！", vbInformation

    Else
        MsgBox "処理を中断します"
    End If

        'オブジェクトを解放します。
        Set olItem = Nothing
        Set olConItems = Nothing
        Set olFolder = Nothing
        Set olNamespace = Nothing
        Set olApp = Nothing
        Set olItemBefor = Nothing
        Set recOther = Nothing
End Sub

実装手順は以下の通りです。

今回はExcel側にこのVBAを実装します。
①Excelを新規に開き、「開発」タブをクリックし、「VisualBasic」をクリックします。
もしくはショートカットキー「Alt」＋「F11」でもOKです。

②標準モジュールを追加します。
左ペインのVBAProjectを右クリックし、「挿入」、「標準モジュール」を選択します。

③右ペインのウインドウに上記のマクロを入力します。

こちらで完了です。

VBAを設定する

VBAを設定していきましょう。

共有の連絡先のアドレス（メールアドレス、表示名）を指定します。

Set recOther = olNamespace.CreateRecipient("＜共有の連絡先のアドレスを指定＞")

タカヒロ

共有の連絡先の見分け方は、連絡先へ表示されているアドレスが自分のアドレス以外のものであるかで判断をしましょう。

取得結果を記述する行番号を指定します。2を指定した場合2行目のセルから開始されることになります。

lnContactCount = 2

VBAを実行する

①「開発」タブの「マクロ」をクリックし「Outlookの共有の連絡先を登録_更新する」を選択し、「実行」をクリックします。

②確認画面がでたら「はい」を選択し、
「Outlook共有の連絡先の反映が完了しました！」のメッセージがでたら完成です！

Outlookの共有の連絡先へ新規登録されているか確認してみましょう。

はい！Excelにあった件数分登録されていますね！

詳細情報もみてみましょう。

詳細もしっかり内容が反映されていますね！

Outlookの共有の連絡先を更新する

続いてExcel側の連絡先データの一部を変更してみましょう。

「姓」と「姓よみ」の値を変更します。

VBAを実行してみましょう。

更新した部分だけOutlookの共有の連絡先が更新されますね！

「姓よみ」が変更されていますね！

VBAについて説明

VBAについて説明をします。

Excelのブックとワークシートのオブジェクトを設定します。

Set wbBook = ThisWorkbook

Excelの1シート目が出力先の対象となります。

Set wsSheet = wbBook.Worksheets(1)

Outlookオブジェクトを設定し、MAPI名前空間を介してOutlookの連絡先一覧を取得します。

Set olApp = New Outlook.Application

Set olNamespace = olApp.GetNamespace("MAPI")

共有の連絡先のアドレスを指定し、GetSharedDefaultFolderメソッドでContactItemというメンバーに格納されているアイテムを取得します。

Set recOther = olNamespace.CreateRecipient("＜共有の連絡先のアドレスを指定＞")

Set olFolder = olNamespace.GetSharedDefaultFolder(recOther, olFolderContacts)

olItemオブジェクトのタイプ名が”ContactItem”だった場合に処理を進めるようにしています。

共有の連絡先一覧の件数分繰り返し処理します。
Cells(1, 3)は3列目C列をみて最終行を判定しています。
最終行判定を別の列にしたいときはCells(1, *)の*を変えてください。

For i = lnContactCount To Cells(1, 3).End(xlDown).Row

EntryIDの有無により新規登録するか更新をするか判定をしています。

If wsSheet.Cells(i, 12) <> "" Then

共有の連絡先のEntryIDをキーにして共有の連絡先を検索します。

If olItemBefor.EntryID = wsSheet.Cells(i, 12) Then

共有の連絡先のEntryIDと一致していたら、該当アイテムをオブジェクトに設定します。

Set olItem = olItemBefor

EntryIDがない場合、連絡先オブジェクトを新規作成します。

Set olItem = olFolder.Items.Add(olContactItem)

タカヒロ

今まで、CreateItem(olContactItem)をつかいアイテムを新規作成していましたが、場所が規定のルートフォルダになってしまい、追加フォルダ指定の場合はMoveメソッドで移動しなければなりませんでした。
そこで代わりにAddメソッドで、指定フォルダに直接アイテムを追加するよう変更をしました。

アイテムのタイプが連絡先”ContactItem”であるか判定します。

If TypeName(olItem) = "ContactItem" Then

連絡先の各項目へ値を代入します。

 .CompanyName = wsSheet.Cells(i, 1).Value 会社名

.Department = wsSheet.Cells(i, 2).Value	部署

.LastName = wsSheet.Cells(i, 3).Value 姓

.YomiLastName = wsSheet.Cells(i, 4).Value 姓よみ

.FirstName = wsSheet.Cells(i, 5).Value 名前

.YomiFirstName = wsSheet.Cells(i, 6).Value 名前よみ

'.FullName = Cells(i, 7) フルネーム※空欄

.Email1Address = wsSheet.Cells(i, 8).Value メールアドレス

.Email1DisplayName = wsSheet.Cells(i, 9).Value 	メール表示名

.MobileTelephoneNumber = wsSheet.Cells(i, 10).Value 携帯番号

.Body = wsSheet.Cells(i, 11).Value メモ

タカヒロ

.FullName = Cells(i, 7) のフルネームは姓、名より優先的に更新されるため無効化しています。

連絡先アイテムを保存します。

olItem.Save

発行されたEntryIDをExcelへ書き込みします。

wsSheet.Cells(i, 12).Value = olItem.EntryID