Bonjour!
 
Quand un message arrive dans le repertoire Outlook DAS, je lance la macro pour qu'elle sauve toutes les pieces jointes des e-mails avec "ABCD" ou "EFGH" dans le sujet sur le serveur (avec une date au debut). Ensuite les e-mails sont marques lus et effaces. Le probleme est que seulement UNE piece jointe est enregistree    
 
Apparemment, cela viens de la position du :
 
                    Item.UnRead = False
                    Item.Delete
 
Mais si je le met plus tard, par exemple apres le "Next Atmt" ca ne marche pas...
 
Vous auriez pas une idee?
 
Voila le code:
-------------------------------------------------------
Sub DASFJ()
    On Error GoTo DAS_err
    Dim ns As NameSpace
    Dim Inbox As MAPIFolder
    Dim Mail As MailItem
    Dim Item As Object
    Dim Atmt As Attachment
    Dim FileName As String
    Dim i As Integer
    Dim DAS As MAPIFolder
    Set ns = GetNamespace("MAPI" )
    Set Inbox = ns.GetDefaultFolder(olFolderInbox)
    Set DAS = Inbox.Folders("DAS" )
    i = 0
'-----------------------------------------------------------------------------------
'-----------------------------------------------------------------------------------
'-----------------------------------------------------------------------------------
'-----------------------------------------------------------------------------------
'FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
'-----------------------------------------------------------------------------------
    For Each Item In DAS.Items
        For Each Atmt In Item.Attachments
                If InStr(Item.Subject, "ABCD" ) > 0 Then
                    FileName = "\\Server\ABCD\" & _
                    Format(Item.CreationTime, "yymmdd_" ) & Atmt.FileName
                    Atmt.SaveAsFile FileName
                    i = i + 1
                    Item.UnRead = False
                    Item.Delete
                End If
        Next Atmt
    Next Item
'-----------------------------------------------------------------------------------
    For Each Item In DAS.Items
        For Each Atmt In Item.Attachments
                If InStr(Item.Subject, "EFGH" ) > 0 Then
                    FileName = "\\Server\EFGH" & _
                    Format(Item.CreationTime, "yymmdd_" ) & Atmt.FileName
                    Atmt.SaveAsFile FileName
                    i = i + 1
                    Item.UnRead = False
                    Item.Delete
                End If
        Next Atmt
    Next Item
'-----------------------------------------------------------------------------------
'-----------------------------------------------------------------------------------
'-----------------------------------------------------------------------------------
DAS_exit:
    Set Atmt = Nothing
    Set Item = Nothing
    Set ns = Nothing
    Exit Sub
'-----------------------------------------------------------------------------------
DAS_err:
    MsgBox "An unexpected error has occurred." _
        & vbCrLf & "Please note and report the following information." _
        & vbCrLf & "Macro Name: GetAttachments" _
        & vbCrLf & "Error Number: " & Err.Number _
        & vbCrLf & "Error Description: " & Err.Description _
        , vbCritical, "Error!"
    Resume DAS_exit
 
End Sub

Je ne connais pas ce message d'erreur...
Comment veux-tu qu'on t'aide si tu ne nous dis pas ce qui se passe?

 
En fait il n'y a pas de message d'erreur, quand je met
 
Item.UnRead = False  
Item.Delete  
 
apres Next Atmt. "Ca marche" mais ca ne fait pas ce que je veux: le code efface chaque message du repertoire DAS

Ben oui, c'est tout à fait logique puisque tu l'appliques à tous les messages.
 
Utilise une booléenne que tu positionnes à faux avant "For Each Atmt In Item.Attachments".
Tu la positionnes à vrai après "If InStr(Item.Subject, "ABCD" ) > 0 Then"
Et enfin, tu la testes après "Next Atmt" et tu delete si vrai.
 
Voilà.

AlainTech,
 
Merci pour ta reponse,
 
Ca devrait donner ca:
 
    For Each Item In DAS.Items  
        For Each Atmt In Item.Attachments = False
                If InStr(Item.Subject, "ABCD" ) > 0 Then = True
                    FileName = "\\Server\ABCD\" & _  
                    Format(Item.CreationTime, "yymmdd_" ) & Atmt.FileName  
                    Atmt.SaveAsFile FileName  
                    i = i + 1  
                End If  
        Next Atmt  
IF True then        
Item.UnRead = False  
Item.Delete
End if
    Next Item  
 
 
 ? Desole je suis tres debutant en VBA...

Non, ça devrait plutôt donner ça:
 

 
Edit --> Zut, j'avais laissé un = False après For Each. Je l'ai supprimé

Merci. Je comprends mieux maintenant (et en plus ca marche donc c'est formidable!)