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