从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

您可以尝试使用while或do/while循环，而不是使用foreach循环：

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

此外，请记住，文件夹可能包含不同类型的项目。因此，在将项类型强制转换为特定类或访问并非所有项类型中都可用的特定属性之前，您需要签出该项类型。