Скрипт для удаления сообщений Outlook удаляет не все сообщения

#vba #powershell #email #outlook

#vba #powershell #Адрес электронной почты #outlook

Вопрос:

Я пытаюсь удалить сообщения в 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:

Не удаляйте элементы в цикле, который изменяет количество элементов. Используйте цикл вниз ( for i = Items.Count to 1 step -1 в VB).