Galaxy シリーズを中心としたAndroidのカスタマイズの覚書です。
現在のメイン機種はGalaxy Note 9(グローバル版)。
10年目を迎え、古い投稿を整理・改訂しました。
カスタマイズのまとめ(リンク集)はこちらです。

2013/02/07

Outlook自動転送マクロ


Last Update ; 24/Feb/2013

Outlookを企業内で使っている方からの依頼で、クライアント側で受信メールをGalaxy(Gmail)に自動転送するマクロを作成しました。

説明用に作成したPPTファイルの画像を添付しながら、概要を記したいと思います。(作成したマクロはこのページの一番下に添付しておきます。)

OfficeはMicrosoft Office Professional Plus 2010。Outlookのバージョンは14.0.6023.1000(32ビット)です。

注)添付のマクロを使用される場合は自己責任にてお願いします。特に、企業内のメールシステムで使用される場合は、個人情報保護ポリシーやセキュリティー設定に十分注意してください。

【仕様と制限事項】


【事前準備】

デジタル証明書の作成


「開発」オプションの表示


 【マクロの登録】



  

【マクロのセキュリティの確認】



【マクロの中断方法】


【転送済メールの削除】


【転送メールを保存しない設定】


【Windowsの画面プロパティ設定】


【自動更新後に再起動しない設定】


【転送メールでのReply-Toの指定】


【メールでのリモート操作によるマクロの中断】


【マクロ例】

' Outlook受信メール自動転送マクロ Ver 1.15
Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
    Dim objItem
    Set objItem = Session.GetItemFromID(EntryIDCollection)
    If objItem.MessageClass = "IPM.Note" Then
        AutoForward objItem
    End If
End Sub
Private Sub AutoForward(ByVal objMail As MailItem)
    '
    '以下のメールアドレスを転送先のメールアドレスに書きなおしてください
    Const ForwardToAddress = "xxxxxxxx@gmail.com"  ' 転送先アドレスを指定
    '
    Dim strFileName As String
    Dim fwMail As MailItem
    Dim i As Integer
    Dim strSenderName As String
    Dim strSenderEmailAddress As String
    Dim strSubject As String
    Dim strTo As String
    Dim strCc As String
'
' 受信メールの自動仕分けルールや迷惑メールフィルタと併用した場合のエラー対策
On Error GoTo ErrorTrap
    '
    ' 受信メールから表題や送受信者情報を取得
    strSubject = objMail.Subject    ' 表題を取得
    strSenderName = objMail.SenderName  ' 送信者名を取得
    strSenderEmailAddress = objMail.SenderEmailAddress  ' Emailアドレスを取得
    strTo = objMail.To  ' 宛先を取得
    strCc = objMail.CC  ' CC宛先を取得
    '
    ' 送信者名と送信者のEmailアドレスの表示処理
    ' 送信者名と送信者のEmailアドレスが同じ場合はEmailアドレスのみ表示
    If strSenderName = strSenderEmailAddress Then
        strSenderName = strSenderEmailAddress
    ' 送信者名と送信者のEmailアドレスが異なる場合は「送信者名+」で表示
    Else
        ' 送信者のメールアドレスがEmailの場合
        If InStr(strSenderEmailAddress, "@") Then
            strSenderName = strSenderName + "<" + strSenderEmailAddress + ">"
        ' 送信者のメールアドレスがExchangeの場合はSMTPアドレスを取得して表示
        Else
            strSenderEmailAddress = _
            objMail.Sender.PropertyAccessor.GetProperty("http://schemas." _
            & "microsoft.com/mapi/proptag/0x39FE001E")
            strSenderName = strSenderName + "<" + strSenderEmailAddress + ">"
        End If
    End If
    '
    ' 宛先がBccの場合の宛先表示処理
        ' Bccで送信されてきた時はBccと表示
        If strTo = "" Then
            strTo = "Bcc"
        Else
        End If
    '
    ' 受信メールをOFTとして保存しOFTから新規メッセージを作成
    strFileName = Environ("TEMP") & "~forward.oft"  '受信メールをOFTとして保存
    objMail.SaveAs strFileName, olTemplate
    Set fwMail = Application.CreateItemFromTemplate(strFileName)    ' メッセージを作成
    With fwMail.Recipients  ' 元メールからコピーされた宛先を削除
        For i = .Count To 1 Step -1
            .Remove i
        Next
    End With
    '
    ' 転送先アドレスを設定
    fwMail.To = ForwardToAddress
    '
    ' 転送先から特定の表題のメールを受信した時にマクロを中断し転送先に中断を通知
    If strSubject = "自動転送中断" Then
        If strSenderEmailAddress = ForwardToAddress Then
            ' 通知メールを作成し送信
            fwMail.Subject = "リモート操作により自動転送を中断しました"
            fwMail.Body = "PCの画面にポップアップしているメッセージボックス内の[OK]を" _
                          & "クリックすると自動転送を再開します。"
            fwMail.Send
            ' PCの画面上にメッセージボックスを表示
            MsgBox "メールによるリモート操作で自動転送用のマクロを中断しています。" & _
                        vbCrLf & "[OK]をクリックすると再開します。"
            Exit Sub
        Else
        End If
    Else
    End If
    '
    ' 転送メールにReply-Toを付加する場合
    ' (サーバー側が送信メールへのReply-Toの付加を許可している場合のみ有効にする)
    ' fwMail.SentOnBehalfOf = strSenderEmailAddress
    '
    ' 表題に送信者名を追記
    fwMail.Subject = strSubject & "<" & strSenderName & ">"
    '
    fwMail.Body = vbCrLf & vbCrLf + fwMail.Body
    '
    ' CCがある場合は本文にCCを追記
    If strCc <> "" Then
        fwMail.Body = " " & vbCrLf & "[Cc] " + strCc + fwMail.Body
    Else
    End If
    '
    ' 本文に時刻、件名、送信者名、Toを追記
    fwMail.Body = "[Sent] " + FormatDateTime(Now, vbShortDate) & " " & _
                        FormatDateTime(Now, vbShortTime) & vbCrLf & _
                       "[Subject] " + strSubject & vbCrLf & _
                       "[From] " + strSenderName & vbCrLf & _
                       "[To] " + strTo + fwMail.Body
'
' 転送メールを送信
    fwMail.Send '
'
ErrorTrap:
'
End Sub




【参照サイト】

Outlook 研究所
http://outlooklab.wordpress.com/2012/07/28/

Slashdot
http://slashdot.jp/journal/454776

【更新履歴】

24/Feb/2012
マクロVer 1.15。本文の冒頭に日時も追記する様に変更。マクロ内のコメントを整理。

18/Feb/2012
マクロVer 1.14。 メールでマクロを中断した際のお知らせメールに本文を追加。(マクロの機能自体に変更はありません。)

15/Feb/2013
マクロVer 1.13。メールでのリモート操作によるマクロの中断の際に転送先に通知メールを送る様に変更。

14/Feb/2013
マクロVer 1.12。メールでのリモート操作によるマクロの中断は転送先メールアドレスからに限定。

13/Feb/2013
マクロVer 1.11。メールでのリモート操作によるマクロの中断機能を追加。

12/Feb/2013
制限事項を追記。
マクロVer 1.10。Bccで送信されてきたメールを転送する際には本文の冒頭に"[To] Bcc"とと表示する様に変更。

11/Feb/2013
転送メールを保存しない設定方法を追記。
マクロVer 1.09。Reply-Toについてのオプションを追加し、説明資料も追加。

10/Feb/2013
マクロVer 1.08。マクロ中のコメントを整理しました。処理は変えていません。
マクロVer 1.07。送信者がExchangeユーザの場合もSMTPアドレスを検索して本文の冒頭に表示する様に変更。
マクロVer 1.06。エラー処理(迷惑メールフィルタ起動時対応)を追加。

09/Feb/2013
マクロVer 1.04。転送メールの本文の冒頭に表示する「送信者名」について、Exchangeユーザからのメールの場合は「送信者名」のみ表示(従来通り)し、Emailアドレスからのメールの場合は「送信者名+Emailアドレス」を表示する仕様に変更。但し、「送信者名」と「Emailアドレス」が同じ場合は「送信者名」のみ表示。

07/Feb/2013
マクロVer 1.03。初掲載。

0 件のコメント:

コメントを投稿

システムの改竄やカスタマイズには端末が起動しなくなったり保証の対象外となるリスクが伴います。自己責任にてお願い致します。