0

for each ループを使用して添付ファイルをコピーした後、Outlook で添付ファイルを削除しようとしています。コピー後に最初の添付ファイルを削除するだけで、2 番目の添付ファイルが機能しません。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

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 に答える