Exécution automatique code VBA

Bonjour, je souhaite que le code VBA ci-dessous s'exécute automatiquement à l'ouverture de Outlook et/ou quand un mail arrive dans la dossier "Test" de Outlook. Le code fonctionne parfaitement que je le lance manuellemement mais impossible de le faire s'exécuter en automatique. Merci par avance de votre aide. Laurent

Private Sub Application_Startup()

MsgBox "test"

Dim objNamespace As Outlook.NameSpace

Dim objFolder As Outlook.MAPIFolder

Dim objItem As Object

Dim objAttachment As Outlook.Attachment

Dim saveFolder As String

' Chemin du dossier de destination

saveFolder = "C:\Test\"

' Obtenir l'application Outlook et le dossier "Test"

Set objNamespace = Outlook.Application.GetNamespace("MAPI")

On Error Resume Next

Set objFolder = objNamespace.Folders("test@gmail.com").Folders("Test") ' Remplacez "VotreAdresseMail@gmail.com" par votre adresse e-mail

On Error GoTo 0

If objFolder Is Nothing Then

MsgBox "Le dossier 'Test' n'a pas été trouvé.", vbExclamation

Exit Sub

End If

' Vérifier si un élément est sélectionné

If Outlook.Application.ActiveExplorer.Selection.Count > 0 Then

' Boucler à travers les éléments sélectionnés

For Each objItem In Outlook.Application.ActiveExplorer.Selection

' Vérifier si l'élément est un e-mail

If TypeOf objItem Is MailItem Then

' Vérifier si le titre de l'e-mail contient le mot "test"

If InStr(1, objItem.Subject, "test", vbTextCompare) > 0 Then

' Enregistrer la pièce jointe dans le dossier spécifié

SaveAttachment objItem, saveFolder & "tata\"

' Supprimer l'e-mail après avoir enregistré les pièces jointes

objItem.Delete

' Vérifier si le titre de l'e-mail contient le mot "lolo"

ElseIf InStr(1, objItem.Subject, "lolo", vbTextCompare) > 0 Then

' Enregistrer la pièce jointe dans le dossier spécifié

SaveAttachment objItem, saveFolder & "toto\"

' Supprimer l'e-mail après avoir enregistré les pièces jointes

objItem.Delete

End If

End If

Next objItem

End If

' Libérer les objets

Set objNamespace = Nothing

Set objFolder = Nothing

Set objItem = Nothing

Set objAttachment = Nothing

End Sub

Private Sub SaveAttachment(objItem As Object, saveFolder As String)

' Boucler à travers les pièces jointes de l'e-mail

Dim objAttachment As Outlook.Attachment

For Each objAttachment In objItem.Attachments

' Enregistrer la pièce jointe dans le dossier spécifié

objAttachment.SaveAsFile saveFolder & objAttachment.FileName

Next objAttachment

End Sub

Edit modo : code à mettre entre balises avec le bouton </> merci d'y faire attention la prochaine fois

Bonjour Mortelecque et

Comme vous ne l'avez visiblement pas fait, je vous invite à lire :
- La charte du forum
- Quelques fonctionnalites du forum à connaître

Regardez aussi les petites icônes mises à votre disposition dans la barre de menu qui :
- vous permettent de poster un code (</>)
- ou de clôturer un fil lorsque vous avez terminé (V)

Merci pour votre participation

Cordialement

Edit modo : inutile car déjà fait

Bonjour,

Essayer ce code :

Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
    Dim item As Object
    Dim dossier_réception As Folder, saveFolder As Folder

    Set item = Application.Session.GetItemFromID(EntryIDCollection)
    If item.Class <> olMail Then Exit Sub

    Set dossier_réception = item.Parent
    If dossier_réception.Name <> "Test" Then Exit Sub

    ' Vérifier si le titre de l'e-mail contient le mot "test"
    If InStr(1, item.Subject, "test", vbTextCompare) > 0 Then

        ' Enregistrer la pièce jointe dans le dossier spécifié
        SaveAttachment item, saveFolder & "tata\"

        ' Supprimer l'e-mail après avoir enregistré les pièces jointes
        item.Delete

    ' Vérifier si le titre de l'e-mail contient le mot "lolo"
    ElseIf InStr(1, item.Subject, "lolo", vbTextCompare) > 0 Then

        ' Enregistrer la pièce jointe dans le dossier spécifié
        SaveAttachment item, saveFolder & "toto\"

        ' Supprimer l'e-mail après avoir enregistré les pièces jointes
        item.Delete

    End If

End Sub

Private Sub SaveAttachment(objItem As Object, saveFolder As String)

    ' Boucler à travers les pièces jointes de l'e-mail

    Dim objAttachment As Outlook.Attachment

    For Each objAttachment In objItem.Attachments

    ' Enregistrer la pièce jointe dans le dossier spécifié

        objAttachment.SaveAsFile saveFolder & objAttachment.FileName

    Next objAttachment

End Sub

Bonjour et merci pour le code mais il ne fonctionne pas et il n'a pas l'air de se lancer à l'ouverture de Outlook ou automatiquement quand Outlook est déjà ouvert. J'ai ajouter un msgbox "testé au début de code et il ne s'affiche même pas !

Bonjour et merci pour le code mais il ne fonctionne pas

Ce code s'exécute dès que vous recevez un mail dans un dossier.

Le mail arrive dans la boite de réception mais rien ne s'exécute !

Chez moi, ça fonctionne parfaitement. Peut être un problème de version ? Je suis en Office 2021 et vous en Office 2019.

Vérifiez que vous disposez bien de l'événement "Application.NewMailEx" dans l'éditeur VB de Office Outlook.

Bonjour, l'évènement "application.newmailex" est bien présent mais ça ne fonctionne toujours pas. Impossible également de l'exécuter manuellement, normal ?

J'ai testé sur un version 2016 et 2019 d'Office et même problème !

Ou mettez-vous le code VBA ?

Dans ThisOutlookSession ? Modules ? Modules de classe ? Enfin j'ai testé dans les 3 mais même résultat !

Après vérification, dans votre code vba, votre variable savefolder n'est pas initialisée !

Dans ThisOutlookSession, sélectionner "Application" et l'événement "NewMailEx", ce qui va vous ajouter automatiquement la procédure attachée à cet événement

Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)

End Sub

A l'intérieur de cette procédure, recopier mon code en corrigeant effectivement la variable "saveFolder" et ajouter votre procédure SaveAttachment

Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
    Dim item As Object
    Dim dossier_réception As Folder 
    Dim saveFolder As String

    Set item = Application.Session.GetItemFromID(EntryIDCollection)
    If item.Class <> olMail Then Exit Sub

    Set dossier_réception = item.Parent
    If dossier_réception.Name <> "Test" Then Exit Sub

    ' Vérifier si le titre de l'e-mail contient le mot "test"
    If InStr(1, item.Subject, "test", vbTextCompare) > 0 Then

        ' Chemin du dossier de destination
        saveFolder = "C:\Test\"

        ' Enregistrer la pièce jointe dans le dossier spécifié
        SaveAttachment item, saveFolder & "tata\"

        ' Supprimer l'e-mail après avoir enregistré les pièces jointes
        item.Delete

    ' Vérifier si le titre de l'e-mail contient le mot "lolo"
    ElseIf InStr(1, item.Subject, "lolo", vbTextCompare) > 0 Then

        ' Enregistrer la pièce jointe dans le dossier spécifié
        SaveAttachment item, saveFolder & "toto\"

        ' Supprimer l'e-mail après avoir enregistré les pièces jointes
        item.Delete

    End If

End Sub

Private Sub SaveAttachment(objItem As Object, saveFolder As String)

    ' Boucler à travers les pièces jointes de l'e-mail

    Dim objAttachment As Outlook.Attachment

    For Each objAttachment In objItem.Attachments

    ' Enregistrer la pièce jointe dans le dossier spécifié

        objAttachment.SaveAsFile saveFolder & objAttachment.FileName

    Next objAttachment

End Sub

Vous pouvez vérifier que cet événement se déclenche bien lors de la réception d'un mail en insérant une instruction MsgBox juste après les déclarations Dim des variables.

Bonjour, après nouveau test, ça fonctionne à présent. Merci encore pour votre aide !