Outlookメッセージを削除するスクリプトがすべてのメッセージを削除していません

Question

電子メールヘッダーの特定のタグに基づいてOutlookでメッセージを削除しようとしています。具体的には、「X-ZANTAZ-RECIP」がヘッダーに複数回含まれている場合は、メッセージを残したいと思います。ヘッダーに1回しか入っていない場合は、そのメッセージを削除します。これは私が取り組んでいるアーカイブプロジェクトの一部です。

私はvbaとpowershellにスクリプトを用意しています。どちらもうまくいくようですが、このヘッダータグが1回だけ出現するとすべてのメッセージが削除される前に5回実行する必要があります。私が取り組んでいるサンプルセットには〜70,000件のメッセージが含まれています。最初のパスは〜24,000を削除します。 2回目〜11,000回。第3パス〜3000 ...

最初のパスで該当するメッセージをすべて削除しないのはなぜですか？

のPowershell：

$outlook = New-Object -ComObject 'Outlook.Application' 
$currentFolder = ($outlook.ActiveExplorer()).CurrentFolder.Items 
Foreach ($objemail in $currentFolder){ 
    $objheader = $objemail.PropertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x007D001E") 
    $objoccurances = ([regex]::Matches($objheader, "X-ZANTAZ-RECIP")).count 
    If ($objoccurances -lt 2){ 
     $objemail.Delete() 
     } 
    Write-Host $objoccurances 
    } 

VBA：

Sub DeleteMessages() 
    Dim olItem As Outlook.MailItem, olMsg As Outlook.MailItem 
    Dim strheader As String 
    Dim output As String 
    Dim CountOccurrences As Long 

    For Each olItem In Application.ActiveExplorer.CurrentFolder.Items 'Application.ActiveExplorer.Selection 
     strheader = GetInetHeaders(olItem) 

    Next 

    Set olMsg = Nothing 
    MsgBox "finished" 
End Sub 

Function GetInetHeaders(olkMsg As Outlook.MailItem) As String 
    Const PR_TRANSPORT_MESSAGE_HEADERS = "http://schemas.microsoft.com/mapi/proptag/0x007D001E" 
    Dim olkPA As Outlook.PropertyAccessor 
    Set olkPA = olkMsg.PropertyAccessor 
    GetInetHeaders = olkPA.GetProperty(PR_TRANSPORT_MESSAGE_HEADERS) 
    CountOccurrences = UBound(Split(GetInetHeaders, "X-ZANTAZ-RECIP")) 
    If CountOccurrences < 2 Then 
     olkMsg.Delete 
    End If 
    Set olkPA = Nothing 
End Function 

Answer 1

は、アイテムの数を変更するループ内の項目を削除しないでください。ダウンループ（VBではfor i = Items.Count to 1 step -1）を使用してください。