Comment répondre à un mail avec une macro Excel

Le 03/04/2016 à 19:33

Bonsoir le forum

J'essaie de mettre en place un système de réponse à choix multiples à un mail arrivé dans Outlook, ceci afin de ne pas perdre l'historique de ce mail.

Je fournis en pièce jointe un fichier qui permet de créer un mail avec différents "ListBox".

J'ai deux PB

Le premier je n'arrive pas à faire apparaître le texte dans le Mail

Le deuxième est plus compliqué:

Je voudrais, par le biais d'une fenêtre de sélection ou autre, pouvoir répondre à un mail et non le créer, avec donc la récupération de l'adresse de l'émetteur et le sujet du mail, puis par le biais de mes 'ListBox" préparer ma réponse.

Si quelqu'un connait ou sait faire...

D'avance je vous remercie pour votre aide et pour le temps que vous m'accorderez

71mail-vdr.xlsm (44.80 Ko)
Le 04/04/2016 à 05:57

Bonjour ...

Ce n'est pas du php, il faut sortir sujx des guillements

       .HTMLBody = "PB Résolu,<br> <br>" & suj1 & "<br> __________________etc.
eole-33 a écrit :

Le deuxième est plus compliqué:

Je voudrais, par le biais d'une fenêtre de sélection ou autre, pouvoir répondre à un mail et non le créer, avec donc la récupération de l'adresse de l'émetteur et le sujet du mail, puis par le biais de mes 'ListBox" préparer ma réponse.

Si quelqu'un connait ou sait faire...

Personnellement, j'aurais donc créé la macro dans Outlook ...

Le 05/04/2016 à 12:36

Bonjour le forum

Bonjour Steelson, merci pour ton attention et ton aide

Mais du coup ce que j'ai fais sous excel, je peux le transposer dans Outlook?

Le 05/04/2016 à 12:57

Hum ... mouais !

Les objets n'étant pas les mêmes il faut adapter ! le langage est le même mais pas la manipulation des objets !

Je vais essayer de te trouver un exemple de ce que j'ai fait récemment ...

Sub Reponses_agenda()
' mike.steelson

Dim dossier As Object, liste As Object, sousListe As Object, ladate As Date, lundi As Date, horizon As Integer
Dim convocation As Object, participant As Outlook.Recipient
Dim xls As Object, wb As Object, ws As Object
Dim ligne As Integer

' la fin est-elle supérieure à ce matin 0h00 ?
criteres = "[End] >= " & Chr(34) & Date & " 00:00 AM" & Chr(34)
horizon = 21 ' jours
lundi = (Date - Weekday(Date, vbMonday) + 1) 'debut de la semaine en cours

' création excel
Set xls = CreateObject("Excel.Application")
Set wb = xls.Workbooks.Add()
Set ws = wb.Worksheets(1)
ligne = 1
With ws
    .cells(ligne, 1).Value = "Objet"
    .cells(ligne, 2).Value = "Date & heure"
    .cells(ligne, 3).Value = "Lieu"
    .cells(ligne, 4).Value = "Organisateur"
    .cells(ligne, 5).Value = "Participant"
    .cells(ligne, 6).Value = "email"
    .cells(ligne, 7).Value = "Type"
    .cells(ligne, 8).Value = "Réponse"
    ligne = ligne + 1
End With
xls.Visible = False

Set dossier = Application.ActiveExplorer.CurrentFolder
Set liste = dossier.Items
liste.Sort "[Start]"
liste.IncludeRecurrences = True
Set sousListe = liste.Restrict(criteres)
For Each convocation In sousListe
    If convocation.Class = olAppointment Then
        For ladate = Int(convocation.Start) To Int(convocation.End) Step 1 ' afin de répéter si la réunion couvre plusieurs journées
            If (ladate >= Date) And (ladate < lundi + 7 + horizon) Then

'=============pour chaque convoc=================
' transfert des données vers le fichier excel
With ws
    For Each participant In convocation.Recipients
        If GetRecipientName(participant) <> convocation.Organizer Then
            .cells(ligne, 1).Value = convocation.Subject
            .cells(ligne, 2).Value = convocation.Start
            .cells(ligne, 3).Value = convocation.Location
            .cells(ligne, 4).Value = convocation.Organizer
            .cells(ligne, 5).Value = GetRecipientName(participant)
            .cells(ligne, 6).Value = GetEmail(participant)
            .cells(ligne, 7).Value = GetType(participant.Type)
            .cells(ligne, 8).Value = GetResponseStatus(participant.MeetingResponseStatus)
            ligne = ligne + 1
        End If
    Next
End With
'=============fin chaque convoc==================

            Set participants = Nothing
            End If
        Next ladate
    End If
Next
ws.Columns("A:H").AutoFit
xls.Visible = True

End Sub

Function GetRecipients(itm As Object) As Outlook.Recipients
  Dim obj As Object
  Dim recips As Outlook.Recipients
  Dim types() As String
  types = Split("MailItem,AppointmentItem,JournalItem,MeetingItem,TaskItem", ",")
  If UBound(Filter(types, TypeName(itm))) > -1 Then  ' it's a matching item
    Set obj = itm
    Set recips = obj.Recipients
    Set GetRecipients = recips
  End If
End Function

Function GetRecipientName(meetingRecip As Outlook.Recipient) As String
  GetRecipientName = meetingRecip.Name
End Function

Function GetType(attendeeType As OlMeetingRecipientType) As String
  Select Case attendeeType
    Case 0  ' olOrganizer
      GetType = "Organisateur"
    Case 1  ' olRequired
      GetType = "Participant attendu"
    Case 2  ' olOptional
      GetType = "Participant facultatif"
    Case 3  ' olResource
      GetType = "Ressource"
  End Select
End Function

Function GetResponseStatus(status As OlResponseStatus) As String
  Select Case status
    Case 0
      GetResponseStatus = "Néant"
    Case 1
      GetResponseStatus = "Organisateur"
    Case 2
      GetResponseStatus = "Provisoire"
    Case 3
      GetResponseStatus = "Accepté"
    Case 4
      GetResponseStatus = "Décliné"
    Case 5
      GetResponseStatus = "Sans réponse" ' il semble qu'en cas de non-réponse ce soit la valuer 0, donc Néant
  End Select
End Function

Function GetEmail(recip As Outlook.Recipient)
    Dim pa As Outlook.PropertyAccessor
    Const PR_SMTP_ADDRESS As String = "http://schemas.microsoft.com/mapi/proptag/0x39FE001E"
    Set pa = recip.PropertyAccessor
    GetEmail = pa.GetProperty(PR_SMTP_ADDRESS)
End Function
Le 06/04/2016 à 06:24

Autre bout de code VBA Outlook sur une réunion et non plus l'agenda complet.

Sub Relances_convocation()

' zone à paramétrer ci-dessous pour le message d'envoi
'======================================================
    Const titre = "Relance sur convocation : "

    '<br/> signifie retour à la ligne du texte
    Const message = "Bonjour," _
        & "<br/><br/>Merci de bien vouloir confirmer votre participation à la formation en objet.</b>." _
        & "<br/><br/>Le département formation"
'======================================================

Const nomMacro = "Relances !"
Dim messagerie As Object, email As Object
Dim convocation As Object, participant As Outlook.Recipient

Set convocation = Application.ActiveInspector.currentItem
If convocation.Class <> olAppointment Then
    MsgBox "Abandon - Une occurence d'agenda est-elle bien ouverte ?", vbCritical + vbOKOnly, nomMacro
    Exit Sub
End If

Set messagerie = CreateObject("Outlook.Application")

    For Each participant In convocation.Recipients
        If GetRecipientName(participant) <> convocation.Organizer _
            And participant.Type = 1 _
            And participant.MeetingResponseStatus <> 3 _
            And participant.MeetingResponseStatus <> 4 Then

            Set email = messagerie.CreateItem(0)
            With email
                .To = GetRecipientName(participant)
                .Subject = titre & convocation.Subject & " du " & convocation.Start
                .HTMLBody = message
                .Display
            End With

        End If
    Next

End Sub

nécessite aussi les fonctions données ci-avant.

Le 09/04/2016 à 17:11

Bonjour le forum,

Merci Steelson pour tes exemples

Mille excuse j'étais parti sur autre chose, mais je n'oubli pas ce post

Rechercher des sujets similaires à "comment repondre mail macro"