【VBA】Outlookの共有の連絡先をExcelシートへ一括出力する方法！追加フォルダも出力可！

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

例えば共有の連絡先を一度出力して整理したいときなどです。

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

ですね。

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

についてまとめます。

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

Outlookの共有の連絡先一覧をExcelへ出力するイメージについて説明します。

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

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

Excel側のVBAを実行すると、

Outlookの共有の連絡先情報が

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

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

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

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

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

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

以上です。

Outlookの共有の連絡先をExcelシートへ一括出力するVBA

Outlookの共有の連絡先をExcelシートへ一括出力するVBAを実装していきましょう。

VBAを実装する

VBAの実装先はExcelとなりますので、Excelブックを新規作成します。

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

Sub Outlookの共有の連絡先をExcelへ出力する()

    '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 recOther 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"
        .Cells(1, 11).Value = "Body(Memo)"
        .Cells(1, 12).Value = "EntryID"

        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 recOther = olNamespace.CreateRecipient("＜共有の連絡先のアドレスを指定＞")
    Set olFolder = olNamespace.GetSharedDefaultFolder(recOther, 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
                Cells(lnContactCount, 11).Value = .Body
                Cells(lnContactCount, 12).Value = .EntryID
                
            End With
            lnContactCount = lnContactCount + 1
        End If
    Next olItem
    
    '各オブジェクトを解放します。
    Set olItem = Nothing
    Set olConItems = Nothing
    Set olFolder = Nothing
    Set olNamespace = Nothing
    Set olApp = Nothing
    Set recOther = Nothing
            
    'スクリーンの更新を有効にします。
    Application.ScreenUpdating = True
    
    MsgBox "Outlookの共有の連絡先の出力が完了しました！", vbInformation
    
End Sub

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

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

③右ペインのウインドウに上記コードを入力し完了です。

VBAを設定する

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

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

タカヒロ

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

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

VBAを実行する

①「開発」タブの「マクロ」をクリックし「Outlookの共有の連絡先をExcelへ出力する」を選択し、「実行」をクリックします。

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

確認をしてみましょう。

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

VBAについて説明

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

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

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

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

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

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

出力する連絡先の項目を指定します。

上記以外の連絡先項目プロパティは以下となっていますので、必要に応じて追記頂ければと思います。

例えば13番目の列に「Email2Address」を追加する場合は、

のようにしてください。

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

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

共有の連絡先へ追加したフォルダの連絡先情報を出力する方法について説明をします。

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

に

を追加します。

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

となります。

タカヒロ

「オブジェクトが取得できない」エラーが表示されたらフォルダに対して参照できるアクセス権がない可能性がありますので、権限を確認しましょう。

うまく共有の連絡先の出力ができない場合の対処法

なかなかうまく共有連絡先の出力ができない問い合わせがいくつかありましたので、以下の順序で確認してみてください。

1.PCが参照したい共有連絡先のアカウントと同一のドメインに参加しているか確認をする

PCが参照したい共有連絡先のアカウントと同一のドメインに参加しているか確認をお願いします。
例えばローカルアカウントや別ドメインに参加している場合は参照できません。

タカヒロ

以下のエラーメッセージが表示されます。
「レジストリまたはインストールに問題があるため、操作は失敗しました。Outlook を再起動し、もう一度実行してみてください。まだ問題が解決しない場合は、Outlook を再インストールしてください。」

理由はGetSharedDefaultFolderメソッドはVBAの実行ユーザー（つまりPCにログインしているユーザー）にてExchange上の情報を参照するので、Exchange上に存在しないユーザーである場合は認証に失敗するためです。

2.規定のユーザーの連絡先にあるか確認をする

複数アカウントを設定している場合は、取得したい連絡先が規定のユーザーの連絡先になっているか確認をします。
既定になっていない場合は、取得したいユーザーを既定に設定してください。

3.共有連絡先の場所が「連絡先」フォルダとなっているか確認をする

共有連絡先の場所が「連絡先」フォルダ、サブフォルダ指定の場合は「連絡先」フォルダ配下になっているか確認をしましょう。

4.フォルダ名が間違っていないか確認をする

サブフォルダ指定の場合はフォルダ名がVBAの設定値と一致しているか確認をしましょう。

【裏技】ローカルユーザーでも共有の連絡先を取得する方法

PCが参照したい共有連絡先のアカウントと同一のドメインに参加していない場合はGetSharedDefaultFolderメソッドは使えません。

ただ、業務都合上、どうしてもローカルユーザーで外部ドメインの共有の連絡先を参照する必要がある場合があるかと思いますので、GetSharedDefaultFolderメソッドを使わない別の取得方法について説明をします。

タカヒロ

エク短オリジナルの方法となります。
こちらの環境で検証をいたしましたが、すべてのパターンを網羅しているわけではありませんので、
環境に合わない場合がありますことご了承願います。

Step1：ユーザーフォルダの位置番号を確認する

ユーザーフォルダの位置番号を確認していきます。

例えば3つのアカウントがOutlookへ登録されていれば、連絡先を取得したいアカウントが3つの内、何番目に位置するか確認をします。

ユーザーフォルダの位置番号を確認するには以下のVBAを実行し、VBEのイミディエイトウィンドウ（Ctrl+Gで表示されます。）を表示させ、出力結果を確認します。

Sub Outlookフォルダチェッカー()
    'Outlook用の定義
    Dim olApp As Outlook.Application
    Dim olNamespace As Outlook.Namespace
    Dim olFolderstemp As Outlook.Folders
    Dim i As Integer
    Dim j As Integer
    Dim k As Integer
    Dim strTemp As String
        
    Set olApp = New Outlook.Application
    Set olNamespace = olApp.GetNamespace("MAPI")
    Set olFolderstemp = olNamespace.Folders

    For i = 1 To olFolderstemp.Count
        strTemp = strTemp & i & "番目ユーザーフォルダ：" & olFolderstemp(i).Name & Chr(13)
        
        If olFolderstemp(i).Folders.Count > 0 Then
            For j = 1 To olFolderstemp(i).Folders.Count
                strTemp = strTemp & "　1層目：" & olFolderstemp(i).Folders(j).Name & Chr(13)
                If olFolderstemp(i).Folders(j).Name = "連絡先" And olFolderstemp(i).Folders(j).Folders.Count > 0 Then
                    For k = 1 To olFolderstemp(i).Folders(j).Folders.Count
                        strTemp = strTemp & "　　2層目：" & olFolderstemp(i).Folders(j).Folders(k).Name & Chr(13)
                    Next
                End If
            Next
        End If
    Next

    MsgBox "ルートフォルダのチェック/出力完了！VBEのイミディエイトウィンドウ（Ctrl+G）で出力結果を確認してください。", vbInformation
    Debug.Print strTemp

    Set olApp = Nothing
    Set olNamespace = Nothing
    Set olFolderstemp = Nothing

End Sub

実行してみましょう。

以下のような形で出力されていることが確認できます。

「**番目」がユーザーフォルダの位置番号となりますので、取得したいアカウントの番号をメモします。

タカヒロ

「連絡先」フォルダ名が「連絡先」でない場合は2階層目以降取得できません。取得したい場合は以下の”連絡先”を変更するか、「olFolderstemp(i).Folders(j).Name = “連絡先” And」を削除して実行をしてください。
If olFolderstemp(i).Folders(j).Name = “連絡先” And olFolderstemp(i).Folders(j).Folders.Count > 0 Then

Step2：連絡先取得VBAを変更する

次に上記で紹介しました連絡先取得VBAを変更していきます。
また、「**番目」の数値を「Folders(**)」へ入力してください。

■変更前

■変更後

タカヒロ

連絡先のサブフォルダを指定したい場合は、
olNamespace.Folders(**).Folders(“連絡先”).Folders(“＜サブフォルダ名＞”)
としてください。
また「連絡先」デフォルトフォルダではなく別階層にある連絡先フォルダを指定したい場合は
olNamespace.Folders(**).Folders(“＜1層目フォルダ名＞”).Folders(“＜2層目フォルダ名＞”)
の形式で指定をするようにしてください。

こちらで設定完了です。

ローカルユーザーでも共有の連絡先を取得する方法の注意点

連絡先の取得はできましたでしょうか？

ローカルユーザーでも共有の連絡先を取得する方法について紹介しましたが、
注意点が1点あります。

それは、ローカルのフォルダにある連絡先情報を参照しているため、同期元であるExchangeとの差異がある場合があることです。

ですので、PCがオフラインであれば、必ずオンラインにしてExchangeと同期状態にした上、VBAの実行をするようにしてください。

【裏技改良版】ローカルユーザーでも共有の連絡先を取得する方法Ver2

上記でご紹介しました「ローカルローカルユーザーでも共有の連絡先を取得する方法」について、Outlookの再起動後に取得できない可能性があることがわかりましたので、その原因と修正したVBAの内容について説明をします。

不具合の内容とVBAの修正箇所

上記にご紹介しました「ローカルユーザーでも共有の連絡先を取得する方法」ではルートとなるユーザ―フォルダを、位置番号にて特定しオブジェクトを取得する仕様となっています。

しかしながら、Outlookを再起動したりするとその位置番号が変わってしまうようで、そうなった場合、指定番号のフォルダの連絡先情報が取得できなかったり、他のユーザーフォルダの連絡先情報が取得されてしまうこととなります。

そこで、位置番号を直接Foldersコレクションに指定するのではなく、都度ユーザーフォルダ名で検索し該当する位置番号をFoldersコレクションに指定するよう変更をおこなうことにより、不具合を回避するようにしました。

具体的な箇所は、以下の通りです。
■変更前

■変更後

これまでFolders(**)の**に位置番号を指定してきましたが、

でユーザーフォルダ名が含まれているかチェックし、

該当した場合、処理回数をFoldersコレクションの位置番号に設定するようにしています。

なお、ユーザーフォルダ名についてはフォルダチェッカーで実行した結果の以下赤字の部分を選択するようにしてください。

変更したサンプルのVBAは以下の通りです。

修正版VBAコード

Sub Outlookの共有の連絡先をExcelへ出力する_裏技Ver2()

    '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 recOther As Object
    Dim olFolderstemp As Outlook.Folders
    
    '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)
    
    '書き込み先のセルを指定します。また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"
        .Cells(1, 11).Value = "Body(Memo)"
        .Cells(1, 12).Value = "EntryID"

    End With
    
    wsSheet.Activate
    
    'Outlookオブジェクトを設定し、MAPI名前空間を介してOutlookの連絡先一覧を取得します。
    Set olApp = New Outlook.Application
    Set olNamespace = olApp.GetNamespace("MAPI")
    Set olFolderstemp = olNamespace.Folders
    
    For i = 1 To olFolderstemp.Count
        If InStr(olFolderstemp(i).Name, "＜ユーザーフォルダ名＞") Then
            Set olFolder = olNamespace.Folders(i).Folders("連絡先")
            Exit For
        End If
    Next

    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
                Cells(lnContactCount, 11).Value = .Body
                Cells(lnContactCount, 12).Value = .EntryID
                
            End With
            lnContactCount = lnContactCount + 1
        End If
    Next olItem
    
    '各オブジェクトを解放します。
    Set olItem = Nothing
    Set olConItems = Nothing
    Set olFolder = Nothing
    Set olFolderstemp = Nothing
    Set olNamespace = Nothing
    Set olApp = Nothing
            
    'スクリーンの更新を有効にします。
    Application.ScreenUpdating = True
    
    MsgBox "Outlookの共有の連絡先の出力が完了しました！", vbInformation
    
End Sub

さいごに

いかがでしょうか。

今回は

についてました。

この方法で共有の連絡先情報をより効率よく把握できますので、活用いただければと思います。