5
4

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

More than 5 years have passed since last update.

エーピーコミュニケーションズAdvent Calendar 2018

Day 4

VBAでOutlookの仕様『宛先へ付与される「’」』を表示名ごと削除する

Last updated at Posted at 2018-12-03

退屈なことはVBAにやらせよう

OutlookでもExcelと同じようにVBAが使えます。便利なのに、Excelと比較するとあまり知られていないため、少しでも広まればと。
なお、本コードはOutlook2013、2010で動作を確認しています。

Outlookの仕様『宛先への「’」シングルクォーテーション付与』について

Outlookは、宛先、CC、BCCをシングルクォーテーションで囲う仕様になっています。
個人的に、これがなんとなく受け入れ難いです。自分で入れたわけではない余計な文字ですし。
また、下記の事象も発生し、とことんOutlookの仕様に抵抗するしかないと思いました。

  • 『'』だけでなく、『"』に囲まれることがある
  • 『'表記名'<'xxx@xxx.com'>』となった場合、『'』もメールアドレスの一部として認識されメール送信できない
  • 企業文化ですが、顧客に返信する際、表示名に『様』をつける

「'」と表示名を削除するコードとボタンの設定

下記を参考に、たとえばメール作成画面に『’』削除ボタンを配置します。
ボタンにマクロを割り当てる

Private Type typeMailAddress
    enabled As Boolean
    addr As String
    mailtype As Integer
End Type

Const MSG_DELETE_SINGLEQUOTATION As String = "「’」を削除しました"

Public Sub DelSinglequotation()

    Dim orgMail As MailItem
    Set orgMail = ActiveInspector.CurrentItem
    
    ' To,CC,BCCに設定されているメールアドレスの数
    Dim cntAddress As Long
    cntAddress = orgMail.Recipients.Count  
    
    '「’」削除後のメールアドレスを一時的に格納する
    Dim wkMailAddress() As typeMailAddress
    ReDim wkMailAddress(cntAddress) As typeMailAddress
    
    Dim i As Long
    Dim orgRecipient As Recipient
    
    '最後尾のMailAddressから対象にすることにより、メールアドレスの並びを出来る限り保持
    For i = cntAddress To 1 Step -1
        Set orgRecipient = orgMail.Recipients.Item(i)
        
        If orgRecipient.AddressEntry.Type = "SMTP" Then 'Exchangeは対象外
            wkMailAddress(i).addr = Replace(orgRecipient.address, "'", "")
            wkMailAddress(i).mailtype = orgRecipient.Type
            
            orgMail.Recipients.Remove i
            wkMailAddress(i).enabled = True
        Else
            wkMailAddress(i).enabled = False
        End If
    Next
    
    Dim newRecipient As Recipient

    '先頭のMailAddressから対象にすることにより、メールアドレスの並びを出来る限り保持
    For i = 1 To cntAddress
        If wkMailAddress(i).enabled = True Then
            
            ' 退避させた[’]無しメールアドレスを追加する
            Set newRecipient = orgMail.Recipients.Add(wkMailAddress(i).addr)
            newRecipient.Type = wkMailAddress(i).mailtype
            newRecipient.Resolve
        End If
    Next
    
    orgMail.Display
    MsgBox MSG_DELETE_SINGLEQUOTATION
End Sub

備考

表示名がなければ『様』を書かなくても良いんじゃないかという発想ですが、むしろ自動で付けるのもありな気がしました。
今後もOutlookの仕訳ルールで出来ないことをVBA(+α)で実現していきたいと思います。

5
4
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
5
4

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?