使用Excel宏存档邮件

时间:2016-01-07 09:33:49

标签: vba excel-vba email excel

我试图根据主题存档电子邮件。代码在Excel中。使用下面的代码,我尝试将电子邮件从我选择的文件夹移动到文件夹" Arrivo"。为了测试它,我在起始文件夹中有3封电子邮件,其中2封包含单词" sas"在这个主题。输出应该是新文件夹中的2封电子邮件和一个msgbox,告诉我如何移动电子邮件。

Sub Archivia_Mail()

Dim outlookApp
Dim olNs As Outlook.Namespace
Dim Fldr As Outlook.MAPIFolder
Dim olMail As Variant
Dim myTasks
Dim OlApp As New Outlook.Application 'Instance of Microsoft Outlook application
Dim FolderChosen As Outlook.MAPIFolder 'Folder selected by user
Dim myInbox As Outlook.Folder
Dim myDestFolder As Outlook.Folder


Set outlookApp = CreateObject("Outlook.Application")
Set olNs = outlookApp.GetNamespace("MAPI")
Set FolderChosen = olNs.PickFolder
Set Fldr = FolderChosen
Set myTasks = Fldr.Items
Set myInbox = olNs.GetDefaultFolder(olFolderInbox)
Set myDestFolder = myInbox.Folders("Arrivo")

contamail = 0

For Each olMail In myTasks
    If (InStr(1, olMail.Subject, "sas", vbTextCompare) > 0) Then

        'olmail.Display

        olMail.Move myDestFolder
        contamail = contamail + 1
    End If
Next

MsgBox ("Archiviate " & contamail & " email")
End Sub

现在代码只归档1封电子邮件,之后停止。我无法弄清楚它为什么会这样,你能帮助我吗?

1 个答案:

答案 0 :(得分:0)

解决了这个问题。

使用经典循环是问题所在。使用以下代码:

    For iCount = myTasks.Count To 1 Step -1

    If (InStr(1, myTasks(iCount).Subject, "sas", vbTextCompare) > 0) Then

        'olmail.Display

        myTasks(iCount).Move myDestFolder
        contamail = contamail + 1
    End If
Next

解决了问题

相关问题