0

在使用每个循环复制附件后，我一直在尝试删除 Outlook 中的附件。它只是在复制后删除第一个附件，但不会继续处理第二个附件！它只是归结为 End Sub。

Private Sub Items_ItemAdd(ByVal item As Object)

    On Error GoTo ErrorHandler

    'Only act if it's a MailItem
    Dim Msg As Outlook.MailItem
    If TypeName(item) = "MailItem" Then
        Set Msg = item

    'Change variables to match need. Comment or delete any part unnecessary.
        'If (Msg.SenderName = "Name Of Person") And _
        '(Msg.Subject = "Subject to Find") And _
        '(Msg.Attachments.Count >= 1) Then

    'Set folder to save in.
    Dim olDestFldr As Outlook.MAPIFolder
    Dim myAttachments As Outlook.Attachments
    Dim olAttch As Outlook.Attachment
    Dim Att As String

    'location to save in.  Can be root drive or mapped network drive.
    Const attPath As String = "C:\Users\pkshahbazi\Documents\EmailAttachments\"
    Set myAttachments = Msg.Attachments
        For Each olAttch In myAttachments
            Att = olAttch.DisplayName
            If Right(olAttch.FileName, 3) = "zip" Then
            olAttch.SaveAsFile attPath & Att
            olAttch.Delete
            End If
        Next olAttch
    Msg.UnRead = False

End If

ProgramExit:
  Exit Sub

ErrorHandler:
  MsgBox Err.Number & " - " & Err.Description
  Resume ProgramExit
End Sub

我发现 OlAttch.delete 语句混淆了 For Each 循环。

知道如何删除附件。

4

2 回答 2

2

在您之前的问题中，我们从索引循环更改为非索引循环，因为您没有任何.Delete要求。不幸的是，从集合中删除项目需要索引迭代。

这是因为，当您有 3 个项目时：

  • 项目 1 = 附件 1
  • 项目 2 = 附件 2
  • 项目 3 = 附件 3

然后，当您删除第一项（第 1 项/附件 1）时，它会将您带到第 2 项，但是当删除发生时，您会得到如下所示的集合：

  • 项目 1 = 附件 2
  • 项目 2 = 附件 3

所以你的循环将删除项目 1 和 3，但它永远不会触及项目 2。

为您解决此问题的最简单方法是不使用索引循环并重新编写脚本，只需添加另一个循环来执行删除方法。

@Enderland 为此提供了示例。我不会重复他的努力，但我确实想为你解释正在发生的事情。从集合中删除项目时总是如此，您必须以相反的顺序逐步浏览集合。

于 2013-08-27T15:27:21.927 回答
1

试试这个。在您保存后，我添加了代码/注释以迭代并删除所有附件。David Zemens在这里很好地解释了你应该这样做的原因。

您还应该养成在 Outlook VBA 中保存您修改的消息的习惯，因为有时这很重要，有时则不重要，但如果您在需要时不使用它可能会让您感到困惑Save。

 'location to save in.  Can be root drive or mapped network drive.
    Const attPath As String = "C:\Users\pkshahbazi\Documents\EmailAttachments\"
    Set myAttachments = Msg.Attachments
        For Each olAttch In myAttachments
            Att = olAttch.DisplayName
            If Right(olAttch.FileName, 3) = "zip" Then
            olAttch.SaveAsFile attPath & Att
            'olAttch.Delete
            End If
        Next olAttch
        'iterate through all attachments, going backwards
        dim j as integer
        For j = Msg.Attachments.Count To 1 Step -1
            Msg.Attachments.Remove (j)
        Next j

        'make sure to save your message after this
        Msg.save
    Msg.UnRead = False




End If
于 2013-08-27T15:24:50.383 回答