Outlook - Répondre avec pièce(s) jointe(s) Le sujet est résolu

Word, PowerPoint, Outlook, Access et tous les autres logiciels de la suite Office (sauf Excel)
Avatar du membre
Eli
Membre habitué
Membre habitué
Messages : 65
Appréciation reçue : 1
Inscrit le : 14 décembre 2015
Version d'Excel : 2019 FR

Message par Eli » 12 août 2019, 16:22

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
Répondre Sujet précédentSujet suivant
  • Sujets similaires
    Réponses
    Vues
    Dernier message