Question

我一直在尝试在为每个循环复制它们之后删除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循环。

知道如何删除附件。

Answer 1

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

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

第1项=附件1
第2项=附件2
第3项=附件3

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

第1项=附件2
第2项=附件3

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

在不使用索引循环和重写脚本的情况下，为您解决此问题的最简单方法是添加另一个循环来执行delete方法。

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

Answer 2

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

你也应养成保存你在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

对于每个循环：只删除第一个附件

2 个答案: