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

ExcelへまとめたデータからOutlookの追加したフォルダの連絡先へ一括登録したいときはないでしょうか。

そんな時に悩むことは、

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

ですね。

今回は、

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

についてまとめます。

Excel側の連絡先一覧をOutlookの追加したフォルダの連絡先へ登録/更新するイメージ

Excel側の連絡先一覧をOutlookの追加したフォルダの連絡先へ登録/更新するイメージについて説明をします。

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

マクロを実行すると、Outlookの追加したフォルダの連絡先へ一括登録されます。

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

更新した部分だけOutlookの追加したフォルダの連絡先が更新されます！

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

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

Outlookの追加したフォルダの連絡先を更新するにあたり注意すること

Outlookの追加したフォルダの連絡先のバックアップを行う

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

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

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

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

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 olFolder = olNamespace.GetDefaultFolder(olFolderContacts).Folders("＜追加したフォルダ名を指定＞")
    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
End Sub

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

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

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

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

こちらで完了です。

VBAを設定する

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

追加したフォルダの表示名を指定します。

Set olFolder = olNamespace.GetDefaultFolder(olFolderContacts).Folders("＜追加したフォルダ名を指定＞")

タカヒロ

取得対象となる追加フォルダは「規定のフォルダ\連絡先\＜追加フォルダ＞」となります。これ以外に配置したフォルダは対象外となりますので、ご注意ください。

取得結果を記述する行番号を指定します。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")

追加したフォルダ名を指定し、GetDefaultFolderメソッドで規定のフォルダ上にある該当フォルダに格納されているアイテムを取得します。

Set olFolder = olNamespace.GetDefaultFolder(olFolderContacts).Folders("＜追加連絡先フォルダ名＞")

追加したフォルダの連絡先一覧の件数分繰り返し処理します。
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