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或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

还请记住，文件夹可能包含不同类型的项目。因此，您需要先检查项目类型，然后再将其强制转换为特定的类或访问并非所有项目类型都可用的特定属性。

从Outlook阅读信息并移动电子邮件

1 个答案: