【Outlook VBA】Outlook連絡先を一括更新する方法

Outlook連絡先を一括更新したいときはないでしょうか。

たとえば改組などでOutlook連絡先の「部署」項目を一括変更したいときなどです。

そんな時に悩むことは、

・Outlook連絡先を一括更新したいが方法がわからない
・VBAでOutlook連絡先を一括更新したいが方法がわからない

ですよね。

今回はそんなお悩みを解決する、
Outlook連絡先を一括更新する方法について
ご紹介します。

Outlook連絡先を一括更新するイメージ

今回のシナリオは組織改組があり、「人事総務部」から「人事部」へ部署名が変更になったということを想定します。

変更対象はOutlook連絡先に登録されている各ユーザの「部署」となります。

「人事総務部」を「人事部」へ変更する処理をしていきます。

連絡先を一括変更できるのでとても便利ですね！

それでは早速実装してみましょう！

マクロを設置する下準備をする。

以下を参考にVBAコードを配置する場所を表示させます。

Outlook VBAをはじめよう！初心者向け手引き

この設定が終えたら一度Outlookを再起動させてください。

Outlook連絡先を一括更新するVBA

Outlook連絡先を一括更新する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 SearchKey As String
    Dim changeWord As String
    Dim CountNum As Long
    
    '置換対象のワード
    SearchKey = "人事総務部"
    
    '置換後のワード
    ChangeWord = "人事部"
    
    CountNum = 0

    'Outlookオブジェクトを設定し、MAPI名前空間を介してOutlookの連絡先一覧を取得します。
    Set olApp = New Outlook.Application
    Set olNamespace = olApp.GetNamespace("MAPI")
    Set olFolder = olNamespace.GetDefaultFolder(olFolderContacts)
    Set olConItems = olFolder.Items
            
    Dim rc As Integer
    rc = MsgBox("連絡先を更新しますか？", vbYesNo + vbQuestion, "確認")
    
    If rc = vbYes Then
    
        '連絡先のメールアドレスをキーにして連絡先を検索
        Set olItem = olConItems.Find("[Department]='" & SearchKey & "'")
        While TypeName(olItem) = "ContactItem"
        
            With olItem
                '連絡先の各項目へ値を代入
                .Department = ChangeWord
            End With
            'Outlookの連絡先へ保存
            olItem.Save
        
            CountNum = CountNum + 1
            
            Debug.Print olItem.FullName & ":" & olItem.Department & ":" & CountNum & "件"
            Set olItem = olConItems.FindNext
        Wend
        Debug.Print "合計" & CountNum & "件、「" & SearchKey & "」を「" & ChangeWord & "」へ更新をしました"

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


    'Null out the variables.
    Set olItem = Nothing
    Set olConItems = Nothing
    Set olFolder = Nothing
    Set olNamespace = Nothing
    Set olApp = Nothing
    
End Sub