【入門編】【中級者向け】添付ファイルがパスワード付きZIPの場合、解凍をスキップして警告フラグを付与するセキュリティ監視 – Outlook VBA解析バイブル

スポンサーリンク
スポンサーリンク

境界線を守る「監視エージェント」を実装せよ:パスワード付きZIP検知の極意

こんにちは。今日もコードの海を渡っていますか?

「マクロの記録」を使って、決まった操作を自動化することには成功した。でも、もっとこう……「メールが届いた瞬間に、裏側で賢く判断して動いてくれるような、自律的なプログラム」を書きたい。そう思ったことはありませんか?

もしあなたが今、その境界線に立っているなら、おめでとうございます。あなたは「作業の自動化」から「システムの自動化」へとステップアップしようとしています。

今回のテーマは、セキュリティの観点からも非常に重要な「パスワード付きZIPファイルの検知」です。
多くの企業では、セキュリティソフトが中身をスキャンできない「パスワード付きZIP」の受け取りを制限しています。これをOutlook VBAで自動検知し、警告フラグを立てる「監視エージェント」を構築しましょう。

単なるコードの書き方だけでなく、「なぜその書き方をするのか」という設計思想まで、深く掘り下げていきますよ。

1. 設計図:監視エージェントの思考プロセス

いきなりコードを書き始めるのは、設計図なしにビルを建てるようなものです。まずは、私たちのエージェントがどう動くべきか、そのロジックを整理しましょう。

1. イベントの検知: 新しいメールが届いた瞬間(`NewMailEx`イベント)に起動する。
2. 対象の特定: 届いたメールの中に「添付ファイル」があるか確認する。
3. 拡張子の選別: 添付ファイルが `.zip` であるかを確認する。
4. 中身の「試行」検査: ここが肝です。ZIPファイルを解凍しようとするのではなく、「中身を読み取れるか」をテストし、失敗したら「パスワード付き」と判定する。
5. アクション: パスワード付きと判断されたら、メールに「警告フラグ(カテゴリ)」を付与し、ユーザーに知らせる。

2. 実装:プロフェッショナルな監視コード

では、実際のコードを見ていきましょう。このコードは、Outlookの `ThisOutlookSession` に記述する必要があります。

' ThisOutlookSession に記述してください
Option Explicit

''' <summary>
''' 新しいメールを受信したときに自動的に実行されるイベント
''' </summary>
''' <param name="EntryID">受信したアイテムの一意識別子</param>
Private Sub Application_NewMailEx(ByVal EntryID As String)
    Dim objMail As Outlook.MailItem
    Dim objNamespace As Outlook.NameSpace
    
    ' 1. EntryIDからメールオブジェクトを取得
    ' EntryIDは「メールの住所」のようなもの。これを使って実体(オブジェクト)を呼び出します。
    Set objNamespace = Application.GetNamespace("MAPI")
    On Error Resume Next
    Set objMail = objNamespace.GetItemFromID(EntryID)
    On Error GoTo 0
    
    ' メールアイテムでない場合は終了(会議出席依頼などを除外するため)
    If objMail Is Nothing Then Exit Sub
    
    ' 2. 添付ファイルのチェックプロセスを開始
    CheckAttachmentsForPasswordZip objMail
    
    ' オブジェクトの解放(メモリ管理の基本です)
    Set objMail = Nothing
    Set objNamespace = Nothing
End Sub

''' <summary>
''' 添付ファイルを走査し、パスワード付きZIPを検知するメインロジック
''' </summary>
Private Sub CheckAttachmentsForPasswordZip(ByRef mailItem As Outlook.MailItem)
    Dim objAttachment As Outlook.Attachment
    Dim shellApp As Object
    Dim zipFolder As Object
    Dim isPasswordProtected As Boolean
    Dim filePath As String
    Dim tempFolder As String
    
    ' 一時保存用のパス(検知のために一度ファイルを物理的に見る必要があるため)
    tempFolder = Environ("TEMP") & "\"
    
    ' 添付ファイルがない場合は即終了
    If mailItem.Attachments.Count = 0 Then Exit Sub

    ' Shell.Application オブジェクトの生成(ZIPの中身を覗くために使用)
    Set shellApp = CreateObject("Shell.Application")

    For Each objAttachment In mailItem.Attachments
        ' 拡張子が .zip かどうかを判定
        If LCase(Right(objAttachment.FileName, 4)) = ".zip" Then
            
            ' 一時フォルダに一旦保存
            filePath = tempFolder & objAttachment.FileName
            objAttachment.SaveAsFile filePath
            
            isPasswordProtected = False
            
            ' --- ここが「極限の知見」ポイント:パスワード検知のロジック ---
            ' ZIPの中身にアクセスしようとして、エラーが出るかどうかで判定します。
            On Error Resume Next
            ' Shellオブジェクトを使って、ZIPの中身(フォルダ)として扱う
            Set zipFolder = shellApp.Namespace(CVar(filePath))
            
            ' zipFolderがNothing、あるいは中身のアイテム数にアクセスできない場合は
            ' パスワード保護されているか、ファイルが破損していると判断
            If zipFolder Is Nothing Then
                isPasswordProtected = True
            Else
                ' 中身のアイテムにアクセスを試みる(ここでエラーが出るかチェック)
                ' 実際には、Namespace自体は取得できても、中身のリスト取得に失敗するケースを狙います
                Dim testItem As Object
                Set testItem = zipFolder.Items.Item(1) 
                
                ' もしアイテムが存在しても、何らかの理由でアクセスに失敗する場合の予備判定
                If Err.Number <> 0 Then
                    isPasswordProtected = True
                End If
            End If
            On Error GoTo 0
            
            ' 3. 判定結果に基づいたアクション
            If isPasswordProtected Then
                ' 警告カテゴリを付与(「要確認:パスワード付きZIP」という名前のカテゴリを作っておいてください)
                mailItem.Categories = "要確認:パスワード付きZIP"
                mailItem.UnRead = True ' 既読になっていても強制的に未読にする
                
                ' ログ出力(イミディエイトウィンドウ)
                Debug.Print "【警告】パスワード付きZIPを検知: " & objAttachment.FileName & " (Mail: " & mailItem.Subject & ")"
            End If
            
            ' 後片付け:一時ファイルを削除
            If Dir(filePath) <> "" Then Kill filePath
        End If
    Next objAttachment
    
    Set shellApp = Nothing
    Set zipFolder = Nothing
End Sub

3. ここがプロへの分かれ道:コードの解説と「落とし穴」

コードをただコピペするだけでは、あなたはまだ「ユーザー」です。「エンジニア」になるために、以下の3つのポイントを魂に刻んでください。

① `NewMailEx` vs `ItemAdd`

初心者はよく `Items.Add` イベントを使おうとしますが、プロは `NewMailEx` を選びます。
なぜか? `NewMailEx` は、メールが届いた瞬間に「EntryID」という唯一無二の識別子を渡してくれるからです。これにより、オブジェクトの取得が極めて確実になり、処理の高速化と安定性が格段に向上します。

② 「エラーハンドリング」こそが設計の要

今回のコードで最も重要なのは `On Error Resume Next` の使い方です。
本来、エラーハンドリングは「隠すためのもの」ではなく、「予期せぬ事態を制御するためのもの」です。
「ZIPの中身にアクセスしようとしてエラーが出る」という、エラーそのものを検知のトリガーとして利用している点に注目してください。これが「プログラミング的な思考」です。

③ オブジェクトのライフサイクル(メモリ管理)

`Set objMail = Nothing`。
これ、地味ですが非常に重要です。Outlookは長時間起動し続けるアプリケーションです。作成したオブジェクトを適切に解放しないと、メモリリーク(メモリの無駄遣い)が発生し、数日後にはOutlookが重くなったり、クラッシュしたりする原因になります。

4. 陥りやすいエラーと対策

実装中にこんな壁にぶつかったら、こう考えてください。

  • 「検知されない!」
  • 原因:`Categories` で指定した名前が、実際のOutlookのカテゴリ名と一致していない可能性があります。Outlookの画面で一度、手動でそのカテゴリを作成しておいてください。
  • 対策:`Debug.Print` を活用して、どこまで処理が進んでいるかイミディエイトウィンドウで確認しましょう。
  • 「動作が重い!」
  • 原因:添付ファイルが大量にあるメールを受信した際、一つずつ物理ファイルとして保存して検査しているためです。
  • 対策:今回は学習用ですが、実運用では「ファイルサイズが一定以上のものはスキップする」といったガード条件を入れるのがプロの技です。

最後に:一歩踏み出すあなたへ

今回の実装は、単なる「自動化」を超えて、組織を守る「セキュリティ・エージェント」の第一歩です。

「動けばいい」というフェーズから、「壊れないように、かつ効率的に動かすにはどうすべきか?」というフェーズへ。この視点を持てたとき、あなたのコードは「ただの命令」から「知的なシステム」へと進化します。

ここをクリアすれば、Outlook VBAの基本はバッチリですよ。
次は、もっと複雑な条件……例えば「特定の送信者からのメールだけを別フォルダに隔離する」といった、高度なルーティングにも挑戦してみてくださいね。

応援しています!

タイトルとURLをコピーしました