我不明白为什么我无法用VBA删除Outlook邮件

时间:2014-09-15 21:07:42

标签: vba outlook

我正试图将使用Outlook规则和VBA的系统拼凑在一起,将电子邮件正文复制到纯文本文件中进行进一步处理,然后从Outlook中删除邮件。

我无法使用Outlook规则删除邮件,因为我无法控制Outlook在规则中执行操作的顺序。如果我可以做“运行脚本,然后删除”作为一个动作,它就足够了。但是,Outlook只允许我先删除邮件,然后运行脚本,这对我来说没用。

我显然不知道VBA来自地下的一个洞,但是从我从谷歌搜索中得到的东西,我得到了以下VBA,我做了我需要的东西除了我无法弄清楚如何删除电子邮件。

到目前为止

代码:

Public Sub SaveBody3(Item As Outlook.MailItem)
    Dim olApp As Outlook.Application
    Dim olNs As NameSpace
    Dim Fldr As MAPIFolder
    Dim olMail As MailItem
    Dim i As Integer  
    Dim fso As New FileSystemObject
    Dim ts As TextStream

    Set olApp = New Outlook.Application
    Set olNs = olApp.GetNamespace("MAPI")
    Set Fldr = olNs.GetDefaultFolder(olFolderInbox)

    i = 1

    For Each olMail In Fldr.Items
        If InStr(olMail.Subject, "my_very_specific_subject_line") Then
            Set ts = fso.OpenTextFile("\\path\to\textfile\filename_" & Format(Now, "yyyymmddhhnnss") & ".txt", ForWriting, True)
            ts.Write (olMail.Body)
            ts.Close
            olMail.Delete 'Shouldn't this delete??
            Set ts = Nothing
            Set fso = Nothing
            i = i + 1
        End If
    Next olMail

    Set Fldr = Nothing
    Set olNs = Nothing
    Set olApp = Nothing

End Sub

2 个答案:

答案 0 :(得分:0)

您的代码在我的计算机上运行完美。检查你的垃圾桶。如果您根据对具有特定主题行的所有邮件的搜索来评估要删除的电子邮件,则您不会注意到要删除的电子邮件,因为它只是移动到您的垃圾箱(但仍然存在) )。清空垃圾箱,运行代码,然后查看垃圾文件夹中是否显示任何内容。

答案 1 :(得分:0)

有时For Each不能按预期工作。在索引更改时跳过项目。

建议是向后删除。 http://msdn.microsoft.com/en-us/library/office/ff863343(v=office.15).aspx “Delete方法删除集合中的单个项目。要删除文件夹的Items集合中的所有项目,必须删除从文件夹中的最后一项开始的每个项目。”

如果没有在当前循环中有效,请尝试此操作。

Dim j As Long

For j = Fldr.Items.count To 1 Step -1

    If TypeOf Fldr.Items(j) Is mailitem Then

        Set olMail = Fldr.Items(j)

        If InStr(olMail.subject, "my_very_specific_subject_line") Then
            Set ts = fso.OpenTextFile("\\path\to\textfile\filename_" & Format(Now, "yyyymmddhhnnss") & ".txt", ForWriting, True)
            ts.Write (olMail.body)
            ts.Close
            olMail.Delete
            Set ts = Nothing
            Set fso = Nothing
            i = i + 1
        End If

        Set olMail = Nothing

    End If

Next j