2008/12/03
[macro][Outlook2007]..や.@が入ったアドレスに送信
Outlook2007は、メールアドレスに.の連続(hoge...hoge@example.com)や@の前に.がある場合(hoge.hoge.@example.com)にはメールを送信することができません。受信トレイに「システム管理者」から送信不能と通知メッセージが入ります。
これは別にOutlook2007が悪いんじゃなくて、RFCに準拠しているためです。でもDocomoやauなど、このRFCに準拠していないキャリアがあって、結構、よく見ます。その辺の詳しい事情はこちらなどをどうぞ。
で、Outlookユーザーはじゃあこれらのメアドにはメールを送れないのか、と言うとそうではなく、実は裏技があって、@の前の部分を""(ダブルクォーテーション)でくくることで送信可能になります。
"hoge...hoge"@example.comや"hoge.hoge."@example.comなどのようにします。これはOKとRFCで規定されてるらしいですね。
でも毎回これを手で入力するのはメンドイ!
ということでなんとかしてみました。
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean) Dim oMailItem As MailItem Dim bExistInvalidAddress As Boolean If TypeName(Item) = "MailItem" Then Set oMailItem = Item Dim reAddress As New RegExp reAddress.Pattern = "([a-zA-Z0-9\-\_\.]+)\@([a-zA-Z0-9\-\_\.]+)" reAddress.Global = True sMailAddresses = Split(oMailItem.To, ";") For I = 0 To UBound(sMailAddresses) If (InStr(sMailAddresses(I), "..") Or InStr(sMailAddresses(I), ".@")) And _ InStr(sMailAddresses(I), """") = 0 Then sMailAddresses(I) = reAddress.Replace(sMailAddresses(I), """$1""@$2") bExistInvalidAddress = True End If Next If bExistInvalidAddress Then oMailItem.To = Join(sMailAddresses, ";") Cancel = True End If End If End Sub
このようなコードをThisOutlookSessionに埋め込みます。VBエディタでF2キーを押してMicrosoft VBScript Regular Expression 1.0と5.5を参照設定してください。ただしマクロなんで毎回起動時にマクロを有効にするか聞かれます。(以上の意味が分からない方は使わないほうが無難です)
すると、問題あるメールアドレスのメールを送信しようとすると、正しくクォーテーションがつけられたメールアドレスに変換します。ただしTo:だけです。Cc:やBcc:にも対応してもよかったんですがそれは宿題ということで。
Cancel=Trueは要らないと思ったんですが、これを取るとなんかさらに''でクォートされて送信トレイに残骸が残ってしまいます。ので、一度メール編集画面に戻るようにしています。
元記事:http://blogs.wankuma.com/mutaguchi/archive/2008/12/03/162596.aspxプライバシーポリシー