删除Outlook邮件的脚本不会删除所有邮件

时间:2016-10-21 15:59:13

标签: email powershell outlook outlook-vba

我正在尝试根据电子邮件标头中的特定标记删除Outlook中的邮件。具体来说,如果" X-ZANTAZ-RECIP"多次在标题中,我想保留消息。如果它只在标题中一次,我想删除该消息。这是我正在处理的档案项目的一部分。

我在vba和powershell中有脚本。两者似乎都工作但我必须运行它5次才能删除所有只有一次此标头标记的消息。我正在处理的样本集包含约70,000条消息。第一遍删除~24,000。第二关~11,000。第三关~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

1 个答案:

答案 0 :(得分:0)

不要删除更改项目数的循环中的项目。使用向下循环(VB中的for i = Items.Count to 1 step -1)。