連絡先の [インターネット メール形式] を一括設定するマクロ


コメントで「連絡先の電子メールのプロパティの [インターネット メール形式] を一括してテキスト形式にするマクロがあれば便利」というご要望を頂きました。
そこで、マクロを作り始めたのですが、意外と面倒でした。
まず、Outlook Object Model ではこのプロパティが定義されていないのですが、Outlook 2007 以降なら PropertyAccessor により MAPI プロパティを直接扱えるので、何とかなるだろうと考えていました。
しかし、ざっと MAPI プロパティを見ても、インターネット メール形式を保持していそうなプロパティが見当たりません。
そこで、[インターネット メール形式] の設定を変更する前と変更した後で、全ての MAPI プロパティの値を比較したところ、以下のプロパティ (バイナリデータ) に保存されているということがわかりました。

http://schemas.microsoft.com/mapi/id/{00062004-0000-0000-C000-000000000046}/80850102

このプロパティの 23 バイト目の数値がそれぞれ以下の設定に対応しています。

0 = Outlook リッチ テキスト形式で送信
1 = 最適な送信形式を自動的に選択する
7 = テキスト形式で送信

また、電子メール 2 と電子メール 3 は最後の 8 文字がそれぞれ 80950102、80a50102 となります。
これを変更するマクロは以下の通りです。連絡先フォルダで変更したい連絡先アイテムを選択し、下記のマクロを呼び出すと、その連絡先のすべての電子メールアドレスのプロパティで [インターネット メール形式] を [テキスト形式で送信] に変更します。

Public Sub ForceTextFormat()
    Dim objContact
    Dim arrEntryID
    Dim bModified
    Const PTAG_EMAIL1_ENTRYID = "http://schemas.microsoft.com/mapi/id/{00062004-0000-0000-C000-000000000046}/80850102"
    Const PTAG_EMAIL2_ENTRYID = "http://schemas.microsoft.com/mapi/id/{00062004-0000-0000-C000-000000000046}/80950102"
    Const PTAG_EMAIL3_ENTRYID = "http://schemas.microsoft.com/mapi/id/{00062004-0000-0000-C000-000000000046}/80a50102"
    Const POS_ENCODING = 23 - 1 ' 配列の添え字は 0 から始まるので -1 しています。
    Const FORCE_TEXT = 7
    For Each objContact In ActiveExplorer.Selection
        If objContact.MessageClass = "IPM.Contact" Then
            bModified = False
            If objContact.Email1AddressType = "SMTP" Then
                arrEntryID = objContact.PropertyAccessor.GetProperty(PTAG_EMAIL1_ENTRYID)
                If arrEntryID(POS_ENCODING) <> FORCE_TEXT Then
                    arrEntryID(POS_ENCODING) = FORCE_TEXT
                    objContact.PropertyAccessor.SetProperty PTAG_EMAIL1_ENTRYID, arrEntryID
                    bModified = True
                End If
            End If
            If objContact.Email2AddressType = "SMTP" Then
                arrEntryID = objContact.PropertyAccessor.GetProperty(PTAG_EMAIL2_ENTRYID)
                If arrEntryID(POS_ENCODING) <> FORCE_TEXT Then
                    arrEntryID(POS_ENCODING) = FORCE_TEXT
                    objContact.PropertyAccessor.SetProperty PTAG_EMAIL2_ENTRYID, arrEntryID
                    bModified = True
                End If
            End If
            If objContact.Email3AddressType = "SMTP" Then
                arrEntryID = objContact.PropertyAccessor.GetProperty(PTAG_EMAIL3_ENTRYID)
                If arrEntryID(POS_ENCODING) <> FORCE_TEXT Then
                    arrEntryID(POS_ENCODING) = FORCE_TEXT
                    objContact.PropertyAccessor.SetProperty PTAG_EMAIL3_ENTRYID, arrEntryID
                    bModified = True
                End If
            End If
            If bModified Then
                objContact.Save
            End If
        End If
    Next
End Sub


マクロの登録方法やメニューへの追加について

広告

コメントを残す

以下に詳細を記入するか、アイコンをクリックしてログインしてください。

WordPress.com ロゴ

WordPress.com アカウントを使ってコメントしています。 ログアウト / 変更 )

Twitter 画像

Twitter アカウントを使ってコメントしています。 ログアウト / 変更 )

Facebook の写真

Facebook アカウントを使ってコメントしています。 ログアウト / 変更 )

Google+ フォト

Google+ アカウントを使ってコメントしています。 ログアウト / 変更 )

%s と連携中