【Outlook VBA】Outlook連絡先をVBAのSavaメソッドで一括更新してみよう

前回に続いて今回はOutlook連絡先の「部署」項目を対象にVBAのSaveメソッドを使用して置換を行ってみたいと思います。

【Outlook VBA】Outlook連絡先をVBAのFindメソッドで検索してみよう

今回のシナリオ

今回のシナリオは組織改組があり、「人事総務部」から「人事部」へ部署名が変更になったということで、Outlook連絡先に登録されている各ユーザの「部署」が「人事総務部」に該当する場合は「人事部」へ変更する処理を行体と思います。

Saveメソッドについて

今回利用するメソッドはSaveとなります。
Saveメソッドはアイテムを保存・上書き保存します。

構文は以下の通りです。

Object(Item).Save

Item単体を指定する必要があることに注意してください。

処理はFindおよびFindNextメソッドで「人事総務部」を検索し、該当したアイテムの「部署」である「Department」へ「人事部」を代入し、最後にアイテムをSaveメソッドで保存するといった流れとなります。

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

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

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

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

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

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



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

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

Outlook VBAをはじめよう!

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

マクロを登録する

「開発」タブ>「Visual Basic」を押します。

「Visual Basic Editor」にて、[Project1] > [Microsoft Outlook Objects] > [ThisOutlookSession] を開きます。

右クリックし、「挿入」、「標準モジュール」を選択します。

「標準モジュール」「Module1」を選択し、右のコードエリアへ、以下のコードを貼り付けて保存します。

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 ChengeWord As String
    Dim CountNum As Long
    
    '置換対象のワード
    SearchKey = "人事総務部"
    
    '置換後のワード
    ChengeWord = "人事部"
    
    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 = ChengeWord
            End With
            'Outlookの連絡先へ保存
            olItem.Save
        
            CountNum = CountNum + 1
            
            Debug.Print olItem.FullName & ":" & olItem.Department & ":" & CountNum & "件"
            Set olItem = olConItems.FindNext
        Wend
        Debug.Print "合計" & CountNum & "件、「" & SearchKey & "」を「" & ChengeWord & "」へ更新をしました"

    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

今回は「イミディエイトウィンドウ」を利用しますので、VBEのメニューの「表示」から「イミディエイトウィンドウ」を選択し、表示させてください。

さっそく置換をしてみる

検索キーワードと置換ワードを確認します。今回は「人事総務部」が検索キーワード、「人事部」が置換ワードとなります。

メニューの➡アイコンか「F5」を押してマクロを実行します。

はい!「イミディエイトウィンドウ」に置換結果が表示されましたね!

では、連絡先をみてみましょう。

はい、[部署]が変更されていますね。

前回のFindメソッドを利用して「人事部」のリストを出してみましょう。
検索キーワードに「人事部」を設定し、メニューの➡アイコンか「F5」を押してマクロを実行します。

はい、結果は問題ないようですね。

最後に

いかがでしょうか。
今回は「部署」だけですが、電話番号などほかの項目も同じ要領で一括置換が可能ですので、試してみてください。

コメントを残す

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