Mail auto VBA et suivi du mail en tache

bonjour , pourriez vous m’aider? voici ce que je souhaite faire mais malgré des tentatives en vba ou par la gestion de règles je n’arrive pas transcrire ça en vba . Pour que quand je clique sur envoie cela fasse comme la règle suivante .

option Explicit
Public nomfichier As String
Public typefichier As String
Public Recherche As String
Public pj As String

Public Sub Application_Reminder(ByVal Item As Object)

    Dim objMsg As MailItem

    Set objMsg = Application.CreateItem(olMailItem)

    If Item.MessageClass <> "IPM.Appointment" Then 'Vérifie si il sagit d'un rapel dans le calendrier
        Exit Sub
    End If

    If Item.Categories <> "MAILS AUTOMATIQUES" Then 'Vérifie si le rappel fait partie de la catégorie: MAILS AUTOMATIQUES
        Exit Sub
    End If

    objMsg.Importance = olImportanceHigh
    objMsg.To = Item.Location
    objMsg.CC = "romain.@"
    objMsg.Subject = Item.Subject
    objMsg.Body = Item.Body

    'demande AR
    objMsg.OriginatorDeliveryReportRequested = True
    'demande confirmation de lecture
    objMsg.ReadReceiptRequested = True

  Dim nom_fichier As String, nom_fichier_complet As String, répertoire As String
    Dim Fso As Object, dossier_départ As Object

    '// création objet FilesSystem
    Set Fso = CreateObject("Scripting.FilesystemObject")

    '// Choix du nom_fichier
    nom_fichier = Item.Subject

    '// Choix du répertoire de départ
    répertoire = "C:\Users\....."

    '// recherche des fichiers
    Set dossier_départ = Fso.GetFolder(répertoire)
    nom_fichier_complet = Empty
    rech_fichier Fso, dossier_départ, nom_fichier, nom_fichier_complet
    If nom_fichier_complet = Empty Then MsgBox "Aucune pièce jointe ne correspond a ce rappel !", vbOKOnly + vbCritical, "Problème de pièce-jointe" _
      Else: MsgBox "Une pièce jointe  correspond a ce rappel !Pensez à établir et envoyé le devis!! En cliquant sur OK  vous allez géneré le mail,et un rappel pour le devis. ", vbOKOnly + vbInformation, "Une pièce-jointe existe pour ce rappel!"

    objMsg.Attachments.Add pj
    'MsgBox "Noubliez pas de faire le devis pour ce rappel!", vbOKOnly, vbCritical, "Rappel rédaction devis!"
    objMsg.Categories = "DEVIS POUR CONTROLE PERIODIQUE"
     objMsg.FlagRequest = "Assurer un suivi"
    objMsg.TaskSubject = "DEVIS" + Item.Subject
    objMsg.TaskStartDate = Now
    objMsg.TaskDueDate = Now + 10
    ogbjmsg.ReminderSet = True
    objMsg.ReminderTime = Now + 1
   objmsg.
    objMsg.Display
    'objMsg.Categories = "DEVIS POUR CONTROLE PERIODIQUE"
    'objMsg.FlagRequest = "Assurer un suivi"
    'objMsg.TaskSubject = "DEVIS" + Item.Subject
    'objMsg.TaskStartDate = Now
    'objMsg.TaskDueDate = Now + 10
    'ogbjmsg.ReminderSet = True
    'objMsg.ReminderTime = Now + 1

Set Fso = Nothing
Set objMsg = Nothing

End Sub

Sub rech_fichier(Fso As Object, dossier As Object, nom1 As String, nom2 As String)
    Dim sous_dossier As Object, fichier As Object
    Dim nom As String, extension_fichier As String

    '// recherche fichiers
    For Each fichier In dossier.Files
        extension_fichier = Fso.GetExtensionName(fichier.Path)
        nom = Replace(fichier.name, "." & extension_fichier, "") 'supprime l'extension du nom
        If nom = nom1 Then

         nom2 = fichier.Path: Exit For
        End If
    Next fichier
     '// recherche sous-dossier
    For Each sous_dossier In dossier.SubFolders
        If nom2 <> Empty Then Exit For
        rech_fichier Fso, sous_dossier, nom1, nom2
    Next
     pj = nom2

End Sub

une autre petite chose , est il possible de quitter la macros en cliquant sur La Croix de mon message box ? Merci pour votre aide

Bonsoir,

Le code VBA correspondant à la règle devrait être de ce type :

Option Explicit

Private WithEvents email As Outlook.MailItem

Private Sub Application_ItemLoad(ByVal item As Object)
    If item.Class <> olMail Then Exit Sub

    'assignation variable objet email pour activation des evts email
    Set email = item
End Sub

Private Sub email_Send(Cancel As Boolean)
    Dim boîte_messagerie_défaut As Folder

    If email.Subject = "Rappel contrôle périodique" _
    And email.Importance = olImportanceHigh _
    And email.Categories = "DEVIS POUR CONTROLE PERIODIQUE" _
    And email.FlagRequest = "Assurer un suivi" Then
        email.Categories = "DEVIS POUR CONTROLE PERIODIQUE"
        Set boîte_messagerie_défaut = Application.Session.Folders(1)
        Set email.SaveSentMessageFolder = boîte_messagerie_défaut.Folders("MAILS CONTROLE PERIODIQUE")
    End If

End Sub

merci beaucoup pour votre aide.

je dois intégré le code dans this workbook? le soucis, si je comprend bien le code il faut que le sujet du mail soit exactement

"Rappel contrôle périodique"

ou seulement si il contient ces mots?

Merci d'avance, bonne journée.

'// cocher la référence Microsoft Outlook

Private WithEvents OlApp As Outlook.Application
Private WithEvents email As Outlook.MailItem

Private Sub Workbook_Open()
    Set OlApp = CreateObject("Outlook.Application")
End Sub

Private Sub OlApp_ItemLoad(ByVal item As Object)
    If item.Class <> olMail Then Exit Sub

    'assignation variable objet email pour activation des evts email
    Set email = item
End Sub

Private Sub email_Send(Cancel As Boolean)
    Dim boîte_messagerie_défaut As Folder

    If email.Subject = "Rappel contrôle périodique" _
    And email.Importance = olImportanceHigh _
    And email.Categories = "DEVIS POUR CONTROLE PERIODIQUE" _
    And email.FlagRequest = "Assurer un suivi" Then
        email.Categories = "DEVIS POUR CONTROLE PERIODIQUE"
        Set boîte_messagerie_défaut = Application.Session.Folders(1)
        Set email.SaveSentMessageFolder = boîte_messagerie_défaut.Folders("MAILS CONTROLE PERIODIQUE")
    End If

End Sub

bonjour , merci pour votre aide .

j'arrive a avancer péniblement en glanant des infos a droite a gauche, voici ce que je suis arrivé a faire :

Private Sub Application_ItemSend(ByVal item As Object, Cancel As Boolean)
   Dim SentFolder As Folder
    Dim desFolder As Folder

    If item.Subject Like "*test*" Then

          Set SentFolder = Application.Session.GetDefaultFolder(olFolderInbox)
          Set desFolder = SentFolder.Folders("test")
          Set item.SaveSentMessageFolder = desFolder

    End If

    RecupMailEnvoyer

    End Sub

    Sub RecupMailEnvoyer()
 Dim MonOutlook As Object, MonMail As Object
 Dim myItem As Outlook.MailItem
 Dim x As String

    Set MonOutlook = CreateObject("Outlook.Application")
        With MonOutlook.GetNamespace("MAPI").GetDefaultFolder(olFolderSentMail)
        x = .Items.Count 'Permet de compter le nombre d'item et de l'enregistrer dans la variable
        Set MonMail = .Items(x) 'Permet de cibler le dernier mail envoyé
        End With

        If MonMail.Subject Like "*test*" And MonMail.impotance = olimpotancehigh Then

        Else: Exit Sub

            With MonMail
                .MarkAsTask (olMarkToday)
                .FlagRequest = "FAIRE LE DEVIS" 'Ajout drapeau pour Destinataire
                .Categories = "devis" 'Marque la categorie du mail
                .FlagStatus = olFlagMarked ' Ajouter le flag
                .FlagIcon = olRedFlagIcon ' Couleur du Flag, pas d'effet
                .TaskSubject = "devis " + MonMail.Subject 'Sujet
                .TaskStartDate = Date 'Date de départ Aucun effet
                .TaskDueDate = Date + 1 + CDate("9:00:00 AM")
                '.FlagDueBy = DateAdd("d", 15, Date) ' Ajout delai pour la tache destinataire
                .ReminderSet = True    'Activation du Rappel
                .ReminderTime = Date + 1 + CDate("9:00:00 AM")
                .Save
            End With

        End If

End Sub

le seul problème une erreur "438"

sur cette partie

      If MonMail.Subject Like "*test*" And MonMail.impotance = olimpotancehigh Then

n'ayant que les bases en VBA . ce la devient compliqué ou puis-je trouvé des infos sur les déclenchement et autre fonctions spécifique a outlook? merci d'avance bonne journée.

problème trouvé une erreur de frappe il manque un "r" a importance. désolé

Bonjour a tous . merci encore pour l'aide que j'ai eu pour mon projet .Les premier on l'air de fonctionner .

Pour que cela soit un gain de temps complet pour moi , est il possible que lorsque je change la catégorie du suivi de tache il supprime le rappel ?

Quand toute le code fonctionnera, je le publierai au complet pour être sur de donner un code fonctionnel .

bonne soirée merci pour votre aide.