Чтение информации из Outlook и перемещение электронной почты

Question

Я обнаружил, что этот макрос VBA для чтения информации внутри электронных писем работает нормально, мне нужно изменить макрос для перемещения элементов в другую папку после прочтения информации:

Sub GetFromOutlook()

Dim OutlookApp As Outlook.Application
Dim OutlookNamespace As Namespace
Dim Folder As MAPIFolder
Dim OutlookMail As Variant
Dim i As Integer

Set OutlookApp = New Outlook.Application
Set OutlookNamespace = OutlookApp.GetNamespace("MAPI")
Set Folder = OutlookNamespace.GetDefaultFolder(olFolderInbox).Folders("test")

i = 1

For Each OutlookMail In Folder.Items
        Range("eMail_subject").Offset(i, 0).Value = OutlookMail.Subject
        Range("eMail_date").Offset(i, 0).Value = OutlookMail.ReceivedTime
        Range("eMail_sender").Offset(i, 0).Value = OutlookMail.SenderName
        Range("eMail_text").Offset(i, 0).Value = OutlookMail.Body
        OutlookMail.UnRead = False
        i = i + 1
Next OutlookMail

Set Folder = Nothing
Set OutlookNamespace = Nothing
Set OutlookApp = Nothing

End Sub

Я пытаюсь изменить макрос, как показано ниже , теперь он работает, но перемещает не все электронные письма, а только половину каждого запущенного скрипта:

Sub GetFromOutlook()

Dim OutlookApp As Outlook.Application
Dim OutlookNamespace As Namespace
Dim Folder As MAPIFolder
Dim MoveToFolder As MAPIFolder
Dim OutlookMail As Variant
Dim i As Integer

Set OutlookApp = New Outlook.Application
Set OutlookNamespace = OutlookApp.GetNamespace("MAPI")
Set Folder = OutlookNamespace.GetDefaultFolder(olFolderInbox).Folders("test")
Set MoveToFolder = OutlookNamespace.GetDefaultFolder(olFolderInbox).Folders("test_fatto")

i = 0

For Each OutlookMail In Folder.Items
        Range("eMail_subject").Offset(i, 0).Value = OutlookMail.Subject
        Range("eMail_date").Offset(i, 0).Value = OutlookMail.ReceivedTime
        Range("eMail_sender").Offset(i, 0).Value = OutlookMail.SenderName
        Range("eMail_text").Offset(i, 0).Value = OutlookMail.Body
        OutlookMail.UnRead = False
        OutlookMail.Move MoveToFolder
        i = i + 1
Next OutlookMail

Set Folder = Nothing
Set MoveToFolder = Nothing
Set OutlookNamespace = Nothing
Set OutlookApp = Nothing

End Sub

Answer 1

Вместо использования foreach l oop вы можете попробовать использовать циклы while или do / while:

For Each OutlookMail In Folder.Items 

, поэтому вместо этого вы можете использовать следующее:

Dim index As Integer = 0
Dim items as Outlook.Items

Set items = Folder.Items
Set mail as Object

While items.Count > 0
    Debug.Print(index.ToString & " ")
    index += 1

    Set mail = items.GetLast()
End While

Также помните, что папка может содержать различные типы элементов. Таким образом, вам необходимо проверить тип элемента перед его преобразованием в определенный класс или доступом к определенным c свойствам, доступным не для всех типов элементов.