enregistrement sélectif des PJ

[sanfric]

Bonjour,
j'utilise ce code ( qui n'est pas de moi) pour enregistrer les pièces jointes reçues dans Outlook 2007; il fonctionne bien; je l'ai même intégré dans une règle (script reconnu en remplaçant Sub par Function).

Sub PJ()
Const olFolderInbox = 6
 
Set objoutlook = CreateObject("Outlook.Application")
Set objNamespace = objoutlook.GetNamespace("MAPI")
Set objFolder = objNamespace.GetDefaultFolder(olFolderInbox)
 
Set colItems = objFolder.Items
 
For Each objMessage In colItems
    intCount = objMessage.Attachments.Count
    If intCount > 0 Then
        For i = 1 To intCount
            objMessage.Attachments.Item(i).SaveAsFile "F:\Photos\réception\" & _
                objMessage.Attachments.Item(i).FileName
        Next
    End If
Next
 
End Sub

Je souhaiterais y intégrer un If... Then pour enregistrer seulement les fichiers *.jpg. Un connaisseur plus pointu que moi pourrait-il m'aider . Merci.

[Oliv-]

Salut,

Voici une solution :

Sub PJ()
Const olFolderInbox = 6
 
Set objoutlook = CreateObject("Outlook.Application")
Set objNamespace = objoutlook.GetNamespace("MAPI")
Set objFolder = objNamespace.GetDefaultFolder(olFolderInbox)
 
Set colItems = objFolder.Items
 
For Each objMessage In colItems
    intCount = objMessage.Attachments.Count
    If intCount > 0 Then
        For i = 1 To intCount
        if UCASE(right(objMessage.Attachments.Item(i).FileName;3))="JPG" then
            objMessage.Attachments.Item(i).SaveAsFile "F:\Photos\réception\" & _
                objMessage.Attachments.Item(i).FileName
        end if
        Next
    End If
Next
 
End Sub

[sanfric]

Bonjour,

Il y avait une petite erreur de syntaxe dans le code précédent. Cela fonctionne avec le code suivant.

   If UCase(Right(objMessage.Attachments.Item(i).FileName, 3)) = "JPG" Then

Pour ceux et celles qui souhaiteraient résoudre le même problème, le code complet de ce SaveAttachments sélectif qui trie les fichiers joints selon leur type

Function PJ (strID As Outlook.MailItem)
Set objoutlook = CreateObject("Outlook.Application")
Set objNamespace = objoutlook.GetNamespace("MAPI")
Set objFolder = objNamespace.GetDefaultFolder(olFolderInbox)
 
Set colItems = objFolder.Items
For Each objMessage In colItems
   intCount = objMessage.Attachments.Count
    If intCount > 0 Then
        For i = 1 To intCount
          Rem enregistrement sélectif
        
            If UCase(Right(objMessage.Attachments.Item(i).FileName, 3)) = "JPG" Then
            objMessage.Attachments.Item(i).SaveAsFile "F:\Photos\réception\" & _
                objMessage.Attachments.Item(i).FileName
             End If
             If UCase(Right(objMessage.Attachments.Item(i).FileName, 3)) = "DOC" Then
            objMessage.Attachments.Item(i).SaveAsFile "F:\TEXTPHO\" & _
                objMessage.Attachments.Item(i).FileName
             End If
           
        Next
    End If
    
    
Next
 
 
End Function

Cela fonctionne chez moi: à tester par d'autres.
Merci à Oliv pour ses suggestions