【VBA】ExcelデータからOutlook連絡先へ一括登録する方法!更新も可能!

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

例えば前任者の引継ぎで連絡先一覧をもらい、Outlookの連絡先へ一括登録したいときなどです。

そんな時に悩むことは、

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

ですね。

今回は、

Excelへまとめたデータを使用してOutlookの連絡先を一括登録する方法

についてご紹介します。

Excel側の連絡先一覧をOutlookの連絡先へ反映する方法について

今回の方法は前回の「Outlookの連絡先情報をExcelデータから一括更新する方法」の続編となり、前回は一部の更新でしたが、今回は新規登録をおこないます。

従いまして、VBAの実装先は前回と同様、Excelブック側となります。

サンプルシナリオとしては、4ユーザを新規に追加する場合としています。

データは以下の記事を参考にするとカンタンに用意できますのでご参考ください。

【VBA】Outlookの連絡先をExcelシートへ一括出力する方法!87項目まとめ!

連絡先へ登録するデータの構成は以下の通りです。
連絡先情報を何件か入力していきます。

CompanyName Department LastName YomiLastName FirstName YomiFirstName FullName Email1Address Email1DisplayName MobileTelephoneNumber


タカヒロ

タカヒロ
FullnameとEmail1DisplayNameの値はOutlook側で自動生成されるため、Excel側は空欄でOKです。


今回の処理フローは以下の通りとなります。
第一メールアドレスをキーにして検索し、該当がなければ新規登録する流れとなります。

Excelブック(VBA) → このメアドの人が登録されていなければ登録してね → Outlook 検索するのでちょいまち。
Excelブック ← 連絡先に追加したよ。 ← Outlook 登録できた。

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

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

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

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

「ファイル」>「開く/エクスポート」>「インポート/エクスポート」>「ファイルにエクスポート」>「Outlookデータファイル(PST)」

ではバックアップができたら早速実装をして動かしてみましょう。

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

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

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

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

以上です。

VBAを実装する

続いて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
    
    'Excel用の定義
    Dim wbBook As Workbook
    Dim wsSheet As Worksheet
    Dim lnContactCount As Long
    Dim Kizonhanei
    
    'Outlook連絡先の既存アイテムへ反映させる場合は"1"を指定してください。新規登録のみ行いたい場合は”1″以外(”0”でOKです)を指定してください。
    Kizonhanei = "1"
    
    'スクリーンの更新を行わないようにします。
    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)
    Set olConItems = olFolder.Items
            
    '取得結果を記述する行番号を指定します。2行目のセルから開始されることになります。
    lnContactCount = 2
    
    'Excelシートをアクティブにします。
    wsSheet.Activate

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

        '連絡先一覧の件数分繰り返す。
        For i = lnContactCount To Cells(1, 1).End(xlDown).Row
            '連絡先のメールアドレスをキーにして連絡先を検索
            Set olItem = olConItems.Find("[Email1Address]='" & Cells(i, 8) & "'")
            
            If TypeName(olItem) = "ContactItem" And Kizonhanei = "1" Then
                    With olItem
                        '連絡先の各項目へ値を代入
                        .CompanyName = Cells(i, 1)
                        .Department = Cells(i, 2)
                        .LastName = Cells(i, 3)
                        .YomiLastName = Cells(i, 4)
                        .FirstName = Cells(i, 5)
                        .YomiFirstName = Cells(i, 6)
                        .FullName = Cells(i, 7)
                        .Email1Address = Cells(i, 8)
                        .Email1DisplayName = Cells(i, 9)
                        .MobileTelephoneNumber = Cells(i, 10)
                    End With
                    'Outlookの連絡先へ保存
                    olItem.Save
           Else
            '連絡先へ登録がなかった場合の処理
            '連絡先オブジェクトをolItemへ設定
            Set olItem = olApp.CreateItem(olContactItem)
                    With olItem
                        '連絡先の各項目へ値を代入
                        .CompanyName = Cells(i, 1)
                        .Department = Cells(i, 2)
                        .LastName = Cells(i, 3)
                        .YomiLastName = Cells(i, 4)
                        .FirstName = Cells(i, 5)
                        .YomiFirstName = Cells(i, 6)
                        .Email1Address = Cells(i, 8)
                        .MobileTelephoneNumber = Cells(i, 10)
                    End With
                    'Outlookの連絡先へ保存
                    olItem.Save
            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
End Sub

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

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

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

こちらで完了です。

早速実行してみよう

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

②確認画面がでたら「はい」を選択し、以下のメッセージがでたら完成です!

Outlookの連絡先を確認してみる

さっそくOutlookの連絡先が更新されているか確認してみましょう。

変更前は以下の通り3人の登録しかありません。

変更後は、

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

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

Excelの内容が反映されていますね!

今回のVBAについて説明

フラグを一つ追加しました。これはExcel側の既存連絡先が含まれていた時にOutlook連絡先の既存のアイテムへ反映するか否かを選択するものです。

Outlook連絡先の既存アイテムへも反映させる場合は”1″を指定してください。既存アイテムへの反映はせずに新規登録のみ行いたい場合は”1″以外(”0″でOKです)を指定してください。

Kizonhanei = “1”

Excel側の連絡先一覧の件数分処理を繰り返すように設定します。

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

で、「Find」メソッドを使用し、連絡先の第一メールアドレスをキーにしてOutlookの連絡先のレコードを検索します。
「Find」メソッドの構文は以下の通りです。

oFolder.Items.Find("[項目] = '値'")

項目[Email1Address]が第一メールアドレスのことで、Cells(i, 8)はメールアドレスが格納されているセルの値を参照しています。

Set olItem = olConItems.Find(“[Email1Address]='” & Cells(i, 8) & “‘”)

既存アイテムの編集処理となります。
オブジェクトolItemのタイプが”ContactItem”かつフラグが1だったときにセルの値をOutlookに格納する処理を行います。

次に検索該当なしの場合は“Nothing”となり、前回は処理をスキップしていましたが、今回は新規に登録する処理を追加しました。

CreateItemメソッドはOutlookアイテムを追加するメソッドで、変数(olContactItem)は連絡先のタイプとなります。つまり空の連絡先アイテムをolItemオブジェクトへセットする内容となります。

Set olItem = olApp.CreateItem(olContactItem)

続いて空の連絡先アイテムへ値を代入していきます。

With olItem
‘連絡先の各項目へ値を代入
.CompanyName = Cells(i, 1)
.Department = Cells(i, 2)
.LastName = Cells(i, 3)
.YomiLastName = Cells(i, 4)
.FirstName = Cells(i, 5)
.YomiFirstName = Cells(i, 6)
.Email1Address = Cells(i, 8)
.MobileTelephoneNumber = Cells(i, 10)
End With
‘Outlookの連絡先へ保存
olItem.Save
End If

仕上げにOutlookの連絡先へ保存します。

olItem.Save

マクロ実行ボタンを設置

マクロ実行ボタンを設置するとさらに操作がカンタンで便利です。

①「開発」タブをクリックし、「挿入」、「フォームコントロール」の左上のアイコンをクリックします。

③設置するボタンのサイズをマウスをドラックして決めます。

②実行するマクロを選択します。「Outlookの連絡先を更新する」を選択しましょう。

③設置したボタンに名前を入れましょう。

これで完成です!

PC入れ替えの時や新規着任者のPCに連絡先を登録したい場合は、ボタンぽちでできるので非常に楽ですね。

さいごに

いかがでしょうか。

今回は、

Excelへまとめたデータを使用してOutlookの連絡先を一括登録する方法

についてご紹介しました。

普段よく使う連絡先だからこそ管理も簡単にできたらよいですね。



この記事の関連キーワード

こちらの記事の関連キーワード一覧です。クリックするとキーワードに関連する記事一覧が閲覧できます。



タカヒロ

タカヒロ
Excelの基礎がスルスル入ってくるAmazonランク1位の優良Excel本です。

この基礎本と応用技が多いエク短と組み合わせれば、短時間で誰よりもExcelが使いこなせるかと思います。
>詳細を見てみる 

11 件のコメント

  • すいません、またまた質問させてください。
    エクスポートしたアドレス帳をインポートする際に
    既存の連絡先に更新/登録ではなく、既存とは別の新規の連絡先に登録する方法はございますでしょうか。
    その場合、あらかじめ新規のフォルダを用意する必要がございますでしょうか。

    すみませんが、よろしくお願いいたします。

    • すみません。一点伝え漏れていました。

      新規に連絡先へアイテムを登録する場合、規定の連絡先フォルダへ登録されてますので、
      saveメソッドの後で、以下のようにアイテムを指定フォルダへ移動するようお願いします。

      olItem.Move olFolder

    • 既存とは別の新規の連絡先に登録する方法につき検証をあれこれしてみまして、
      以下のように変更すると取得することが確認できました。
      ■変更前
      Set olFolder = olNamespace.GetDefaultFolder(olFolderContacts)

      ■変更後
      Set olFolder = olNamespace.Folders(1).Folders(“<フォルダ名>”)

      一つ目のFoldersコレクションでルートを、2つ目Foldersコレクションでサブフォルダを指定しています。

      ルートフォルダの指定ですが、アドレス名や表示名の指定ですとうまくいかなかったので位置番号指定にしています。

      アドレスを複数設定している場合は「1」を2,3など他の数値に変更して確認をしてください。

    • 既存とは別の新規の連絡先に登録する方法につきまして、
      調べてみましたが、既存のメソッドでは実現が難しい状況です。

      もし、既存の連絡先以外で連絡先情報を扱うことを希望されている場合は
      別アドレスの「共有の連絡先」を使う方法がありますので、
      ご検討頂ければと存じます。

  • ご回答ありがとうございました。
    色々とご教授いただき感謝しております。

    今後も本サイトを参考に色々とお世話になると思いますので、
    また困りごとがあったら相談させてください。

  • 色々と教えてくださりありがとうございました!
    無事最後まで処理が進むようになりました。

    ちなみになのですが、下記の処理について何を処理しているのか
    教えていただけますでしょうか。

    With wsSheet
    .Range(“A2”, Cells(2, 6).End(xlDown)).Sort key1:=Range(“A2”), order1:=xlAscending
    .Range(“A:F”).EntireColumn.AutoFit
    End With

    例題のマクロと自分で作成したマクロを少し変えているのですが
    上記のコマンドでも動いたので、どこの部分を参照しているのか分からなかったです。
    すいませんが、よろしくお願いいたします。

    • 無事できたようで良かったです。

      ご指摘の処理ですが、Excel側1シート目A列を基準にアルファベット順に並び替える処理となります。

      改めて確認したところ不要な処理と判断したため、大変お手数ですが削除頂ければと存じます。

      また、本記事内のVBAコードも修正させて頂きました。

  • 早速のご返答ありがとうございます!
    教えていただいた通り.Valueプロパティを使用したところ動き出すようにはなったのですが、途中の
    .CompanyAndFullName = Cells(i, 11).Value
    で実行時エラー’440′:オブジェクトはこのメソッドをサポートしていません。
    となってしまいました。
    なぜ.Body = Cells(i, 1).Valueはクリアできたのにここで詰まってしまったのか理由が分からず…
    申し訳ございませんがご教授いただけませんでしょうか。
    よろしくお願いいたします。

    • 解消されたようでよかったです。

      またCompanyAndFullNameプロパティですが、読み取り専用となりますため値を設定することはできません。
      CompanyAndFullNameプロパティはCompanyNameとFullNameプロパティを結合した値となるため、
      CompanyAndFullNameプロパティの値を変更する場合はそれぞれのプロパティを変更頂ければと存じます。

  • アドレス帳一括出力に続いて失礼いたします。
    一括出力の際に87項目全部取りで実行したので、一括登録も自分なりに87項目編集したつもりなのですが、実行時エラー’2147417851(80010105)’:’Body’メソッドは失敗しました.’_ContactItem’オブジェクトのエラーが発生しました。


    Set olItem = olApp.CreateItem(olContactItem)
    With olItem
    ‘連絡先の各項目へ値を代入
    .Body = Cells(i, 1)

    このような感じで87項目作ったのですが、どこが間違えているのかがわからず
    ご教授いただけませんでしょうか。
    お忙しいところ恐れいりますが、よろしくお願いいたします。

    • 実行時エラー「Body’メソッドは失敗」の件につきまして、
      Bodyプロパティに対して文字列型 (String) 以外のタイプを設定した場合に発生するようですので、
      Cells(i, 1).ValueやCells(i, 1).Textプロパティを使用して確認頂きたくお願いいたします。

  • コメントを残す

    メールアドレスが公開されることはありません。 * が付いている欄は必須項目です