Outlook で送信できないメールアドレスを自動的に修正して送信可能とするマクロ


Outlook で送信できないメールアドレス」のコメント欄にて以下のようなご要望をいただきました。


..や.@が含まれるdocomoとezwebあてのアドレスを自動で” “でくくるようなVBAは組めないものでしょうか。


確かに、送信時に自動的に ”” でくくってしまえば送信はできるようになりますね。
マクロは以下のようなものになります。このマクロはメールの送信時に自動的に実行されるので、手動で実行させる必要はありません。

' ここをトリプルクリックでマクロ全体を選択できます。
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
    FixMailAddress Item
End Sub
' 不正なアドレスに "" をつけるサブ プロシージャ
Private Sub FixMailAddress(ByVal objMail As MailItem)
    Dim i As Integer
    Dim strNewAddress As String
    Dim objRec As Recipient
    For i = objMail.Recipients.Count To 1 Step -1
        With objMail.Recipients.Item(i)
            ' 受信者のアドレスに連続するピリオドや @ 直前のピリオドがある場合
            If InStr(.Address, "..") > 0 Or InStr(.Address, ".@") > 0 Then
                ' @ より前を "" でくくる
                strNewAddress = """" & Left(.Address, InStr(.Address, "@") - 1) & """" _
                    & Mid(.Address, InStr(.Address, "@"))
                ' 変更後のアドレスで受信者を追加
                Set objRec = objMail.Recipients.Add("""" & .Name & """ <" & strNewAddress & ">")
                ' To か Cc か Bcc かを指定
                objRec.Type = .Type
                objRec.Resolve
                ' 元の受信者は削除
                .Delete
            End If
        End With
    Next
End Sub

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

広告

Outlook で送信できないメールアドレスを自動的に修正して送信可能とするマクロ」への1件のフィードバック

  1. 動作確認できました。すでにアドレス帳に””でくくって登録してあるアドレスはエラーになるようなので外して対応します。OUTLOOKを利用する上でかなりネックになっていた部分だったのでとても助かります。ありがとうございました。

コメントを残す

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

WordPress.com ロゴ

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

Twitter 画像

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

Facebook の写真

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

Google+ フォト

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

%s と連携中