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

Outlookの連絡先一覧をExcelへ一括出力したいときはないでしょうか。

そんなときに悩むことは、

ですね。

今回はOutlookの連絡先を確認する際に便利な

についてまとめます。

連絡先一覧をExcelへ出力するイメージ

今回のOutlook連絡先出力VBAの実装先は、出力結果を書き込む先のExcelブック側となります。

Excelブック側からスクリプトを実行し以下の流れで処理が行われます。

①Excelブック(VBA) →　連絡先ちょうだい　→ Outlook
②Excelブック ←　連絡先一覧を出すよ　← Outlook

Excel側のVBAを実行すると、

Outlookの連絡先情報が

さくっとExcelのシートへ出力されます！

標準機能で連絡先を出力する

Outlookから連絡先を出力する方法は標準機能でも可能です。
Outlook上にて以下の順序で操作をするとcsvファイル形式で出力することができます。

「ファイル」＞「開く/エクスポート」＞「インポート/エクスポート」＞「ファイルにエクスポート」＞「コンマ区切り値」＞「連絡先」＞出力先を選択＞ファイル名を入力＞処理の確認＞「OK」

タカヒロ

作業のステップが多く使うには少々面倒そうですよね…

そこで今回ご紹介する方法なら、

　　Excel起動してマクロ実行

これだけです！

こちらのほうがカンタンですね！

Outlookもいちいち起動する必要もありません！

では早速実装をして動かしてみましょう！

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

まずExcel VBAからOutlookを操作するための下準備をしていきます。

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

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

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

以上です。

VBAを実装する

続いて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 strDummy As String
    
    'スクリーンの更新は行われません。
    Application.ScreenUpdating = False
    
    'Excelのブックとワークシートのオブジェクトを設定します。
    Set wbBook = ThisWorkbook
    Set wsSheet = wbBook.Worksheets(1)
    
    '書き込み先のセルを指定します。また1行目にタイトルを記述します。
    With wsSheet
        .Range("A1").CurrentRegion.Clear
        .Cells(1, 1).Value = "CompanyName"
        .Cells(1, 2).Value = "Department"
        .Cells(1, 3).Value = "LastName"
        .Cells(1, 4).Value = "YomiLastName"
        .Cells(1, 5).Value = "FirstName"
        .Cells(1, 6).Value = "YomiFirstName"
        .Cells(1, 7).Value = "FullName"
        .Cells(1, 8).Value = "Email1Address"
        .Cells(1, 9).Value = "Email1DisplayName"
        .Cells(1, 10).Value = "MobileTelephoneNumber"

        With .Range("A1:Z1")
            .Font.Bold = True
            .Font.ColorIndex = 10
            .Font.Size = 11
        End With
    End With
    
    wsSheet.Activate
    
    '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
    
    For Each olItem In olConItems
        If TypeName(olItem) = "ContactItem" Then
            With olItem
                Cells(lnContactCount, 1).Value = .CompanyName
                Cells(lnContactCount, 2).Value = .Department
                Cells(lnContactCount, 3).Value = .LastName
                Cells(lnContactCount, 4).Value = .YomiLastName
                Cells(lnContactCount, 5).Value = .FirstName
                Cells(lnContactCount, 6).Value = .YomiFirstName
                Cells(lnContactCount, 7).Value = .FullName
                Cells(lnContactCount, 8).Value = .Email1Address
                Cells(lnContactCount, 9).Value = .Email1DisplayName
                Cells(lnContactCount, 10).Value = .MobileTelephoneNumber

            End With
            lnContactCount = lnContactCount + 1
        End If
    Next olItem
    
    'オブジェクトを解放します。
    Set olItem = Nothing
    Set olConItems = Nothing
    Set olFolder = Nothing
    Set olNamespace = Nothing
    Set olApp = Nothing
    
            
    'スクリーンの更新を有効にします。
    Application.ScreenUpdating = True
    
    MsgBox "Outlook連絡表の出力が完了しました！", vbInformation
    
End Sub

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

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

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

こちらで完了です。

VBAを実行する

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

②「Outlook連絡表の出力が完了しました！」が表示されたら完成です！

確認をしてみましょう。

はい、Outlook連絡表の内容がExcelシートへ出力されていますね！

VBAについて説明

連絡先の項目はContactItemというメンバーに格納されています。
コードではolItemオブジェクトのタイプ名が”ContactItem”だった場合に処理を進めるようにしています。

また連絡先の項目はプロパティに格納されており、今回は以下の項目に絞っています。

連絡先のすべて項目は以下となっていますので、必要に応じて取捨選択頂ければと思います。
例えば11番目の列に「Email2Address」を追加する場合は、

のようにしてください。

【参考】ContactItem メンバー　プロパティ一覧

＜追加＞連絡先の「全般」と「詳細」に入力した87項目の情報をまとめて出力する

次に、連絡先の「全般」と「詳細」に入力した87項目の情報をまとめて出力するようにしていきます。

「全般」

「詳細」

タカヒロ

項目数が多いので、必要に応じて絞り込んでいただければと思います。

サンプルコードは以下の通りです。

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 strDummy As String
    
    'スクリーンの更新は行われません。
    Application.ScreenUpdating = False
    
    'Excelのブックとワークシートのオブジェクトを設定します。
    Set wbBook = ThisWorkbook
    Set wsSheet = wbBook.Worksheets(1)
    
    '書き込み先のセルを指定します。また1行目にタイトルを記述します。
    With wsSheet
    
        '「全般」の項目名をセットします。
        .Cells(1, 1).Value = "Body"
        .Cells(1, 2).Value = "BusinessAddress"
        .Cells(1, 3).Value = "BusinessAddressCity"
        .Cells(1, 4).Value = "BusinessAddressCountry"
        .Cells(1, 5).Value = "BusinessAddressPostalCode"
        .Cells(1, 6).Value = "BusinessAddressState"
        .Cells(1, 7).Value = "BusinessAddressStreet"
        .Cells(1, 8).Value = "BusinessFaxNumber"
        .Cells(1, 9).Value = "BusinessHomePage"
        .Cells(1, 10).Value = "BusinessTelephoneNumber"
        .Cells(1, 11).Value = "CompanyAndFullName"
        .Cells(1, 12).Value = "CompanyName"
        .Cells(1, 13).Value = "ConversationTopic"
        .Cells(1, 14).Value = "CreationTime"
        .Cells(1, 15).Value = "Department"
        .Cells(1, 16).Value = "Email1Address"
        .Cells(1, 17).Value = "Email1AddressType"
        .Cells(1, 18).Value = "Email1DisplayName"
        .Cells(1, 19).Value = "Email1EntryID"
        .Cells(1, 20).Value = "Email2Address"
        .Cells(1, 21).Value = "Email2AddressType"
        .Cells(1, 22).Value = "Email2DisplayName"
        .Cells(1, 23).Value = "Email2EntryID"
        .Cells(1, 24).Value = "Email3Address"
        .Cells(1, 25).Value = "Email3AddressType"
        .Cells(1, 26).Value = "Email3DisplayName"
        .Cells(1, 27).Value = "Email3EntryID"
        .Cells(1, 28).Value = "EntryID"
        .Cells(1, 29).Value = "FileAs"
        .Cells(1, 30).Value = "FirstName"
        .Cells(1, 31).Value = "FullNameAndCompany"
        .Cells(1, 32).Value = "GetInspector"
        .Cells(1, 33).Value = "HasPicture"
        .Cells(1, 34).Value = "Hobby"
        .Cells(1, 35).Value = "Home2TelephoneNumber"
        .Cells(1, 36).Value = "HomeAddress"
        .Cells(1, 37).Value = "HomeAddressCity"
        .Cells(1, 38).Value = "HomeAddressCountry"
        .Cells(1, 39).Value = "HomeAddressPostalCode"
        .Cells(1, 40).Value = "HomeAddressPostOfficeBox"
        .Cells(1, 41).Value = "HomeAddressState"
        .Cells(1, 42).Value = "HomeAddressStreet"
        .Cells(1, 43).Value = "HomeFaxNumber"
        .Cells(1, 44).Value = "HomeTelephoneNumber"
        .Cells(1, 45).Value = "IMAddress"
        .Cells(1, 46).Value = "JobTitle"
        .Cells(1, 47).Value = "LastModificationTime"
        .Cells(1, 48).Value = "LastName"
        .Cells(1, 49).Value = "LastNameAndFirstName"
        .Cells(1, 50).Value = "MailingAddress"
        .Cells(1, 51).Value = "MailingAddressCity"
        .Cells(1, 52).Value = "MailingAddressCountry"
        .Cells(1, 53).Value = "MailingAddressPostalCode"
        .Cells(1, 54).Value = "MailingAddressState"
        .Cells(1, 55).Value = "MailingAddressStreet"
        .Cells(1, 56).Value = "MobileTelephoneNumber"
        .Cells(1, 57).Value = "NoAging"
        .Cells(1, 58).Value = "OrganizationalIDNumber"
        .Cells(1, 59).Value = "OtherAddress"
        .Cells(1, 60).Value = "OtherAddressCity"
        .Cells(1, 61).Value = "OtherAddressCountry"
        .Cells(1, 62).Value = "OtherAddressPostalCode"
        .Cells(1, 63).Value = "OtherAddressPostOfficeBox"
        .Cells(1, 64).Value = "OtherAddressState"
        .Cells(1, 65).Value = "OtherAddressStreet"
        .Cells(1, 66).Value = "OtherFaxNumber"
        .Cells(1, 67).Value = "OtherTelephoneNumber"
        .Cells(1, 68).Value = "Parent"
        .Cells(1, 69).Value = "PropertyAccessor"
        .Cells(1, 70).Value = "WebPage"
        .Cells(1, 71).Value = "YomiCompanyName"
        .Cells(1, 72).Value = "YomiFirstName"
        .Cells(1, 73).Value = "YomiLastName"
        
        '「詳細」の項目名をセットします。
        .Cells(1, 74).Value = "Anniversary"
        .Cells(1, 75).Value = "AssistantName"
        .Cells(1, 76).Value = "Birthday"
        .Cells(1, 77).Value = "FullName"
        .Cells(1, 78).Value = "InternetFreeBusyAddress"
        .Cells(1, 79).Value = "ManagerName"
        .Cells(1, 80).Value = "NickName"
        .Cells(1, 81).Value = "OfficeLocation"
        .Cells(1, 82).Value = "Profession"
        .Cells(1, 83).Value = "Spouse"
        .Cells(1, 84).Value = "Subject"
        .Cells(1, 85).Value = "Suffix"
        .Cells(1, 86).Value = "TaskSubject"
        .Cells(1, 87).Value = "Title"

        With .Range("A1:ZZ1")
            .Font.Bold = True
            .Font.ColorIndex = 10
            .Font.Size = 11
        End With
    End With
    
    wsSheet.Activate
    
    '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
    
    For Each olItem In olConItems
        If TypeName(olItem) = "ContactItem" Then
            With olItem
            
                '「全般」の入力項目を出力します。
                Cells(lnContactCount, 1).Value = .Body
                Cells(lnContactCount, 2).Value = .BusinessAddress
                Cells(lnContactCount, 3).Value = .BusinessAddressCity
                Cells(lnContactCount, 4).Value = .BusinessAddressCountry
                Cells(lnContactCount, 5).Value = .BusinessAddressPostalCode
                Cells(lnContactCount, 6).Value = .BusinessAddressState
                Cells(lnContactCount, 7).Value = .BusinessAddressStreet
                Cells(lnContactCount, 8).Value = .BusinessFaxNumber
                Cells(lnContactCount, 9).Value = .BusinessHomePage
                Cells(lnContactCount, 10).Value = .BusinessTelephoneNumber
                Cells(lnContactCount, 11).Value = .CompanyAndFullName
                Cells(lnContactCount, 12).Value = .CompanyName
                Cells(lnContactCount, 13).Value = .ConversationTopic
                Cells(lnContactCount, 14).Value = .CreationTime
                Cells(lnContactCount, 15).Value = .Department
                Cells(lnContactCount, 16).Value = .Email1Address
                Cells(lnContactCount, 17).Value = .Email1AddressType
                Cells(lnContactCount, 18).Value = .Email1DisplayName
                Cells(lnContactCount, 19).Value = .Email1EntryID
                Cells(lnContactCount, 20).Value = .Email2Address
                Cells(lnContactCount, 21).Value = .Email2AddressType
                Cells(lnContactCount, 22).Value = .Email2DisplayName
                Cells(lnContactCount, 23).Value = .Email2EntryID
                Cells(lnContactCount, 24).Value = .Email3Address
                Cells(lnContactCount, 25).Value = .Email3AddressType
                Cells(lnContactCount, 26).Value = .Email3DisplayName
                Cells(lnContactCount, 27).Value = .Email3EntryID
                Cells(lnContactCount, 28).Value = .EntryID
                Cells(lnContactCount, 29).Value = .FileAs
                Cells(lnContactCount, 30).Value = .FirstName
                Cells(lnContactCount, 31).Value = .FullNameAndCompany
                Cells(lnContactCount, 32).Value = .GetInspector
                Cells(lnContactCount, 33).Value = .HasPicture
                Cells(lnContactCount, 34).Value = .Hobby
                Cells(lnContactCount, 35).Value = .Home2TelephoneNumber
                Cells(lnContactCount, 36).Value = .HomeAddress
                Cells(lnContactCount, 37).Value = .HomeAddressCity
                Cells(lnContactCount, 38).Value = .HomeAddressCountry
                Cells(lnContactCount, 39).Value = .HomeAddressPostalCode
                Cells(lnContactCount, 40).Value = .HomeAddressPostOfficeBox
                Cells(lnContactCount, 41).Value = .HomeAddressState
                Cells(lnContactCount, 42).Value = .HomeAddressStreet
                Cells(lnContactCount, 43).Value = .HomeFaxNumber
                Cells(lnContactCount, 44).Value = .HomeTelephoneNumber
                Cells(lnContactCount, 45).Value = .IMAddress
                Cells(lnContactCount, 46).Value = .JobTitle
                Cells(lnContactCount, 47).Value = .LastModificationTime
                Cells(lnContactCount, 48).Value = .LastName
                Cells(lnContactCount, 49).Value = .LastNameAndFirstName
                Cells(lnContactCount, 50).Value = .MailingAddress
                Cells(lnContactCount, 51).Value = .MailingAddressCity
                Cells(lnContactCount, 52).Value = .MailingAddressCountry
                Cells(lnContactCount, 53).Value = .MailingAddressPostalCode
                Cells(lnContactCount, 54).Value = .MailingAddressState
                Cells(lnContactCount, 55).Value = .MailingAddressStreet
                Cells(lnContactCount, 56).Value = .MobileTelephoneNumber
                Cells(lnContactCount, 57).Value = .NoAging
                Cells(lnContactCount, 58).Value = .OrganizationalIDNumber
                Cells(lnContactCount, 59).Value = .OtherAddress
                Cells(lnContactCount, 60).Value = .OtherAddressCity
                Cells(lnContactCount, 61).Value = .OtherAddressCountry
                Cells(lnContactCount, 62).Value = .OtherAddressPostalCode
                Cells(lnContactCount, 63).Value = .OtherAddressPostOfficeBox
                Cells(lnContactCount, 64).Value = .OtherAddressState
                Cells(lnContactCount, 65).Value = .OtherAddressStreet
                Cells(lnContactCount, 66).Value = .OtherFaxNumber
                Cells(lnContactCount, 67).Value = .OtherTelephoneNumber
                Cells(lnContactCount, 68).Value = .Parent
                Cells(lnContactCount, 69).Value = .PropertyAccessor
                Cells(lnContactCount, 70).Value = .WebPage
                Cells(lnContactCount, 71).Value = .YomiCompanyName
                Cells(lnContactCount, 72).Value = .YomiFirstName
                Cells(lnContactCount, 73).Value = .YomiLastName

                '「詳細」の入力項目を出力します。
                Cells(lnContactCount, 74).Value = .Anniversary
                Cells(lnContactCount, 75).Value = .AssistantName
                Cells(lnContactCount, 76).Value = .Birthday
                Cells(lnContactCount, 77).Value = .FullName
                Cells(lnContactCount, 78).Value = .InternetFreeBusyAddress
                Cells(lnContactCount, 79).Value = .ManagerName
                Cells(lnContactCount, 80).Value = .NickName
                Cells(lnContactCount, 81).Value = .OfficeLocation
                Cells(lnContactCount, 82).Value = .Profession
                Cells(lnContactCount, 83).Value = .Spouse
                Cells(lnContactCount, 84).Value = .Subject
                Cells(lnContactCount, 85).Value = .Suffix
                Cells(lnContactCount, 86).Value = .TaskSubject
                Cells(lnContactCount, 87).Value = .Title

            End With
            lnContactCount = lnContactCount + 1
        End If
    Next olItem
    
    'オブジェクトを解放します。
    Set olItem = Nothing
    Set olConItems = Nothing
    Set olFolder = Nothing
    Set olNamespace = Nothing
    Set olApp = Nothing
    
    'スクリーンの更新を有効にします。
    Application.ScreenUpdating = True
    
    MsgBox "Outlook連絡先の取得が完了しました！", vbInformation
    
End Sub

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

はい、全部取りができていますね！

「全般」

「詳細」

＜追加＞連絡先へ追加したフォルダの連絡先情報を出力する

読者の方より連絡先へ追加したフォルダの連絡先情報を出力する方法はないか要望がありましたので、追記致します。

変更箇所は1か所のみです。

に

を追加します。

例えば連絡先のフォルダ名が「追加連絡先フォルダ」である場合は、

となります。

＜追加＞複数のフォルダの連絡先情報をまとめて出力する

読者の方より複数のフォルダの連絡先情報をまとめて出力する方法はないか要望がありましたので、追記致します。

タカヒロ

例えば、連絡先ビューに
・追加フォルダ1
連絡先アイテム1-1
・追加フォルダ2
連絡先アイテム2-1
とあり、
・連絡先アイテム1-1
・連絡先アイテム2-1
を取得したい場合ですね。

ソースコードの以下の箇所を変更します。

■変更前

■変更後

For EachでFoldersコレクションの要素を繰り返し取得しています。

各フォルダ名も併せて出力したい場合は、

を付け加えてください。
Cells16番目の列であるP列にフォルダ名が出力されます。

タカヒロ

この方法はFoldersコレクションに含まれるデフォルトのフォルダも対象となり、
キャッシュ情報やデフォルトの連絡先アイテムなども出力されますので、
Excel側で不要なデータがあれば削除するようお願い致します。

さいごに

いかがでしょうか。

今回は

についてまとめました。

普段よく使う連絡先だからこそ管理をカンタンにしてミスがないようにしたいですね。