Outlook - Répondre avec pièce(s) jointe(s)

Bonjour,

Je dispose d'un code fonctionnel permettant à partir de réponses-types de répondre à des mails reçus.

Je souhaiterais pouvoir y ajouter l'instruction permettant de répondre aux mails reçus en y ajoutant automatiquement dans la réponse faite toutes les pièces-jointes reçues dans le mail initial.

J'ai trouvé sur le net, un code permettant cela et je souhaiterais l'adapter au code dont je dispose déjà.

Quelqu'un pourrait-il m'aider, SVP?

Code initial :

Private Sub BoutonNouveau_Click()
Dim Courriel As MailItem
Dim Rep As MailItem
Dim obj As Object
If ListBox1.ListIndex = -1 Then
  MsgBox "Sélectionnez un Mail-Type ou Cliquez sur Annuler"
  Exit Sub
End If
Me.Hide
Set Courriel = CreateItemFromTemplate(doss & tabNomsFich(ListBox1.ListIndex))
Courriel.Display
End Sub

Private Sub BoutonRep_Click()
Dim courrielReçu As MailItem
Dim réponse As MailItem
Dim repType As MailItem
Dim obj As Object

If ListBox1.ListIndex = -1 Then
  MsgBox "Sélectionnez un Mail-Type ou Cliquez sur Annuler"
  Exit Sub
End If
Me.Hide
Set obj = ActiveExplorer.Selection(1)
If obj.Class = olMail Then
  Set courrielReçu = obj
  Set repType = CreateItemFromTemplate(doss & tabNomsFich(ListBox1.ListIndex))

    Set réponse = courrielReçu.Reply

    réponse.Display
    réponse.BodyFormat = olFormatHTML
    réponse.HTMLBody = repType.HTMLBody & réponse.HTMLBody

  Set courrielReçu = Nothing
  Set repType = Nothing
  DoEvents
Else

  MsgBox "L'élément sélectionné n'est pas un courrier"
  Exit Sub
End If
End Sub

Code trouvé sur le net : avec la fonctionnalité réponses avec les pièces-jointes

Sub ReplyWithAttachments()
    Dim oReply As Outlook.MailItem
    Dim oItem As Object

    Set oItem = GetCurrentItem()
    If Not oItem Is Nothing Then
        Set oReply = oItem.Reply
        CopyAttachments oItem, oReply
        oReply.Display
        oItem.UnRead = False
    End If

    Set oReply = Nothing
    Set oItem = Nothing
End Sub

Sub ReplyAllWithAttachments()
    Dim oReply As Outlook.MailItem
    Dim oItem As Object

    Set oItem = GetCurrentItem()
    If Not oItem Is Nothing Then
        Set oReply = oItem.ReplyAll
        CopyAttachments oItem, oReply
        oReply.Display
        oItem.UnRead = False
    End If

    Set oReply = Nothing
    Set oItem = Nothing
End Sub
Function GetCurrentItem() As Object
    Dim objApp As Outlook.Application

    Set objApp = Application
    On Error Resume Next
    Select Case TypeName(objApp.ActiveWindow)
        Case "Explorer"
            Set GetCurrentItem = objApp.ActiveExplorer.Selection.Item(1)
        Case "Inspector"
            Set GetCurrentItem = objApp.ActiveInspector.CurrentItem
    End Select

    Set objApp = Nothing
End Function

Sub CopyAttachments(objSourceItem, objTargetItem)
   Set fso = CreateObject("Scripting.FileSystemObject")
   Set fldTemp = fso.GetSpecialFolder(2) ' TemporaryFolder
   strPath = fldTemp.Path & "\"
   For Each objAtt In objSourceItem.Attachments
      strFile = strPath & objAtt.FileName
      objAtt.SaveAsFile strFile
      objTargetItem.Attachments.Add strFile, , , objAtt.DisplayName
      fso.DeleteFile strFile
   Next

   Set fldTemp = Nothing
   Set fso = Nothing
End Sub
Rechercher des sujets similaires à "outlook repondre piece jointe"