Enregistrement automatique PJ Outlook

Bonjour,

Sous Outlook 2016, je souhaite créer une règle automatique qui exécute un script pour sauvegarder les pièces jointes. Pour le moment j'ai pu avancer sur les premières étapes :

- Activation de la fonction "exécuter un script" dans les actions de la règle automatique. En modifiant une clé de registre :

[HKEY_CURRENT_USER\Software\Microsoft\Office\16.0\Outlook\Security]"EnableUnsafeClientMailRules"=dword:00000001

- Création d'un certificat personnel pour la macro à l'aide de SelfCert.exe.

Je bute maintenant sur le contenu de la macro, car après pas mal de recherche de scripts tout faits (je ne sais pas l'écrire moi même), soit la macro n'est pas vue, soit le script répond qu'il n'y a pas de PJ dans le mail, alors que c'est le cas.

Je fait bien alt+F11 pour accéder au module VBA et ajouter un module dans le projet, je sauvegarde. Puis je vais sur un mail et j'appuie sur alt+F8 pour appeler la macro. Voici à quoi elle ressemble.

' ######################################
' Run this macro for saving attachments.
' ######################################
Public Sub ExecuteSaving()
    Dim lNum As Long

    lNum = SaveAttachmentsFromSelection

    If lNum > 0 Then
        MsgBox CStr(lNum) & " attachment(s) was(were) saved successfully.", vbInformation, "Message from Attachment Saver"
    Else
        MsgBox "No attachment(s) in the selected Outlook items.", vbInformation, "Message from Attachment Saver"
    End If
End Sub

Savez-vous me dire ce qui cloche dedans ?

J'en ai essayé d'autres mais elles ne sont pas vue dans les macros.

Bonjour,

Je pense que vous avez une solution beaucoup plus simple. Il vous suffit de créer une règle permettant de copier les messages contenant une pièce jointe dans un dossier Outlook de votre choix. Après éventuellement, via une macro Excel vous pouvez accéder aux pièces jointes des messages contenus dans ce dossier Outlook.

Merci pour la proposition, mais cela ne répondrai pas à mon besoin qui est de récupérer automatiquement les pièces jointes dans un dossier. C'est un dossier partagé avec un accès pour d'autres personnes qui peuvent consulter les pièces jointes.

Bonjour,

J'ai poursuivi mes recherche et ai trouvé un code qui fonctionne (voir en fin de message). Il est bien présent et accessible lorsque j'appelle les macro en faisant alt+F8, et fonctionne sur les messages sélectionnés.

Cependant, il me reste un problème lors de la création de la règle automatique. Quand je dois sélectionner le script à exécuter, celui-ci est introuvable dans la liste.

J'ai donc l'impression qu'il ne faut pas passer par les macros, mais ou dois-je déposer ce script pour pouvoir le retrouver et l'intégrer à ma règle ?

Code du script : (source slipstick)

Public Sub SaveAttachments()
Dim objOL As Outlook.Application
Dim objMsg As Outlook.MailItem 'Object
Dim objAttachments As Outlook.Attachments
Dim objSelection As Outlook.Selection
Dim i As Long
Dim lngCount As Long
Dim strFile As String
Dim strFolderpath As String
Dim strDeletedFiles As String

    ' Get the path to your My Documents folder
    strFolderpath = CreateObject("WScript.Shell").SpecialFolders(16)
    On Error Resume Next

    ' Instantiate an Outlook Application object.
    Set objOL = Application

    ' Get the collection of selected objects.
    Set objSelection = objOL.ActiveExplorer.Selection

' The attachment folder needs to exist
' You can change this to another folder name of your choice

    ' Set the Attachment folder.
    strFolderpath = strFolderpath & "\OLAttachments\"

    ' Check each selected item for attachments. 
    For Each objMsg In objSelection

    Set objAttachments = objMsg.Attachments
    lngCount = objAttachments.Count

    If lngCount > 0 Then

    ' Use a count down loop for removing items
    ' from a collection. Otherwise, the loop counter gets
    ' confused and only every other item is removed.

    For i = lngCount To 1 Step -1

    ' Get the file name.
    strFile = objAttachments.Item(i).FileName

    ' Combine with the path to the Temp folder.
    strFile = strFolderpath & strFile

    ' Save the attachment as a file.
    objAttachments.Item(i).SaveAsFile strFile

    Next i
    End If

    Next

ExitSub:

Set objAttachments = Nothing
Set objMsg = Nothing
Set objSelection = Nothing
Set objOL = Nothing
End Sub

Je m'auto répond après quelques recherches : pour que le script apparaisse dans la liste, il faut modifier le code dans la macro en replaçant :

Public Sub SaveAttachments()

par

Sub script(Mail As MailItem)

(mais du coup il disparait de la liste des macro exécutables)

Ça me semble presque bon... maintenant c'est la règle automatique qui n'en fait qu'a sa tête et ne traite pas les bons mails. Il y a des moments ou j'ai envie de tout balancer par la fenêtre, c'est le cas ce matin :-(

Dernier message, j'ai utilisé un autre script spécialement pour les règles automatiques, disponible sur la même page.

Public Sub SaveAttachments(Item As Outlook.MailItem)

If Item.Attachments.Count > 0 Then

Dim objAttachments As Outlook.Attachments
Dim lngCount As Long
Dim strFile As String
Dim sFileType As String
Dim i As Long

Set objAttachments = Item.Attachments
    lngCount = objAttachments.Count
 For i = lngCount To 1 Step -1

' Get the file name.
 strFile = objAttachments.Item(i).FileName

 ' Get the path to your My Documents folder
    strfolderpath = CreateObject("WScript.Shell").SpecialFolders(16)
    strfolderpath = strfolderpath & "\Attachments\"

' Combine with the path to the folder.
 strFile = strfolderpath & strFile

' Save the attachment as a file.
 objAttachments.Item(i).SaveAsFile strFile

 Next i
End If

End Sub

Ça fonctionne comme sur des roulettes maintenant.