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

おはようございます、タナイです。さて、前回に引き続き第4回です。

今回は項目7と8を説明します。前回、9の途中までを予定していましたが、長いので分割します。

ではさっそくいきましょう。

パスワードメールの特定

前回のエントリで、パスワードメールを含むフォルダの特定までは終わっています。したがって、フォルダの中から自分の設定した条件に合致したメールを検索する方法が分かればOKです。

フォルダに含まれるメール数が多い場合は、.Restrictメソッドを使って絞り込むことになりますが、まずは単純に全件ループで検索してしまいましょう。

ちなみに私はメーラーのInboxには基本メールを溜めないという管理をしているのですが、そうすると全件検索でも実用に耐えます。

さて、今回は例えば、パスワードメールは次のような件名で来るとしましょう。

これに対して、NewMailExで取得したzip添付メール(myMail)を渡すと対応するパスワードメールを返すfindPassMailファンクションは以下のようになります。

Private Function findPassMail(ByVal myMail) As MailItem
    Dim myFolder As Folder
    Set myFolder = myMail.Parent
    Dim myItems As Items
    Set myItems = myFolder.Items
    Dim tgtItem As Object
    For Each tgtItem In myItems
        If "【" & myMail.Subject & "】添付ファイル用パスワードの送付" = tgtItem.Subject Then
            Set findPassMail = tgtItem
            Exit For
        End If
    Next tgtItem
End Function

こんなイメージでしょうか。
ここで検索ループで使うtgtItemをMailItem型で宣言していないのは、会議出席依頼などが混じっていると型の不一致ではじかれるからです。

さすがに、メールが来るたびに全件検索させるのは重いので、日時でRestrictしてみましょう。myMailとmyItemsを受け取って、絞り込み結果を返すファンクションを考えます。

Private Function minimizeSearchRange(ByVal myMail, myItems) As Items
    Dim myDateFrom As Date
    Dim myDateTo As Date
    myDateFrom = DateAdd("h", -1, myMail.ReceivedTime)
    myDateTo = DateAdd("h", 1, myMail.ReceivedTime)
    Set minimizeSearchRange = _
    myItems.Restrict("[受信日時] >= #" & myDateFrom & "# AND " & "[受信日時] <  #" & myDateTo & "#")
End Function

メール受信の前後1時間に受信されたメールに限定しました。パスワードメールの送信されるタイミングが信頼性高ければ前後10分とかにしてしまってもいいかもしれません。

パスワードの抽出

findPassMailファンクションでtgtItemを取得したので、次はその本文からパスワードを抽出しましょう。

ここではたとえば、英数字・大文字小文字・16桁というパスワードを検索することを考えます。

やり方としては、以下の2通りが考えられます。

メール末尾に必ずパスワードがあるとかなら位置で切り出すのが簡単ですが、パスワードメールの本文に添付ファイル名とかが含まれている場合は文字数の前後等もあり得ます。

個人的には、汎用性の高い正規表現で抜き出すのが好きですが、正規表現それ単体で別のシリーズが書けそうなので、サンプルだけ提示します。

tgtItemを受け取って、パスワードを文字列で返します。

Private Function getRegExp(ByVal tgtItem As MailItem) As String
    Dim myBody As String
    myBody = tgtMail.Body
    Dim myRE As Object
    Set myRE = CreateObject("VBScript.RegExp")
    With myRE
        .Pattern = "[0-9a-zA-Z]{16}"
        .IgnoreCase = False
        .Global = True
    End With
    Dim myMatches As Object
    Dim myMatch As Object
    Set myMatches = myRE.Execute(myBody)
    For Each myMatch In myMatches
        getRegExp = myMatch.Value
        Exit For
    Next myMatch
End Function

基本的には、.Patternが条件指定ですので、その部分を改変すれば使用できます。

ちなみに上記だと、[]内の文字を{}回繰り返すという書き方です。

まとめ

今日は以下の2点を解説しました。

次回は、上記で取得したパスワードを用いて、

について解説していきたいと思います。

cmd(コマンドライン)を用いるので、またVBAから離れた内容への理解も必要な部分になりますが、使い始めはモジュールの動く仕組みはどうあれ、どう入力を変えればいいかだけ理解するのがまず先決だと思います。

それでは次回もお楽しみに！

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

...

thanaism.com

2020.03.14