パスワード別送メールのzipを自動で解凍したい #3

2020.03.11

おはようございます、タナイです。今日も前回に引き続き第3回を書いていきます。

前回は項目2まで説明しましたので、今日は項目6まで説明しましょう。

メール受信時のイベントプロシージャとして記述する
受信したメールのIDを取得する
パスワード別送の送信元かを判定する
添付ファイルが含まれているかを判定する
zipファイルであるのかを判定する
メールを含むフォルダを取得する
パスワードメールを特定する
パスワードメールの本文からパスワードを抽出する
7-zipをコマンドラインで起動してzipをテンポラリに解凍する
解凍されたファイルを元のメールの添付ファイルとして追加する
解凍されたファイルをテンポラリから削除する
(必要なら)処理完了のメッセージボックスを表示する

Contents

送信元の特定
添付ファイルを含んでいるかの判定
zipファイルかどうかの判定
メールを含むフォルダの取得
まとめ

送信元の特定

前回は、Application_NewMailExイベントを利用して受信したMailItemオブジェクトを取得しました。

ここまでくればあとは送信元がどのプロパティで取得できるかだけです。ですが、この送信者のアドレスってけっこう曲者なんですよね。

基本的には.SenderEmailAddressプロパティで取得できますが、Exchange環境だと取得できないケースもあります(https://docs.microsoft.com/ja-jp/office/client-developer/outlook/pia/how-to-get-the-smtp-address-of-the-sender-of-a-mail-item?redirectedfrom=MSDN)。

リンク先を少し引用すると、

To determine the SMTP address for a received mail item, use the SenderEmailAddress property of the MailItem object. However, if the sender is internal to your organization, SenderEmailAddress does not return an SMTP address, and you must use the PropertyAccessor object to return the sender’s SMTP address.

ということで、.SenderEmailAddressで難しい場合はプロパティアクセサを使うように書いてあるので、添付ファイルの名称から抽出するという代替手段をとる方がコーディング的にはラクです。

添付ファイルを含んでいるかの判定

添付ファイルの有無はシンプルです。.Attachmentsコレクションの個数で判定します。

Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
 
Dim myMail As MailItem
Set myMail = GetNamespace("MAPI").GetItemFromID(EntryIDCollection)
 
If myMail.Attachments.Count > 0 Then
     MsgBox "This mail has an/some attachment file(s)."
End If
End Sub

zipファイルかどうかの判定

ファイル名そのものは、.Attachments(1).FileNameで取得していきます。

Attachmentsコレクションの1つめのアイテムについて.Filenameプロパティで取得することになりますが、.Nameでない点に注意が必要です。

判定にあたっては、末尾の拡張子が.zipかどうかを見ればいいですし、ファイル名がそもそも規定の文字列＋連番で送られるような送信元の設定なら拡張子を見ずにそっちで判定してもかまわないということになります。

If Right(myMail.Attachments(1).FileName, 4) = ".zip" Then
    MsgBox "This is a zip file."
End If

どちらにせよ送信元ごとにパスワードの送り方が異なるので、どっちにしろそこで分岐することになることを考えて私はファイル名の固定文字列で判断するように作ったものを利用していますが、拡張子で判定するなら大文字ケースも考慮しないといけないかもしれません(調べてないですが、たぶん区別されると思います)。

メールを含むフォルダの取得

同じ送信元から同じフォルダへパスワード記載メールが事前に届いているという前提なので、まずはメールが含まれるフォルダを特定する必要があります。

これは、メールアイテムから1つオブジェクトをさかのぼればOKです。オブジェクトを1つ上の階層にさかのぼる場合には、親オブジェクトを返す.Parentプロパティを使用します。

Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
  
Dim myMail As MailItem
Set myMail = GetNamespace("MAPI").GetItemFromID(EntryIDCollection)
  
Dim myFolder As Folder
Set myFolder = myMail.Parent
End Sub