Comment répondre à un mail avec une macro Excel
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
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 ...
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?
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
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.
Bonjour le forum,
Merci Steelson pour tes exemples
Mille excuse j'étais parti sur autre chose, mais je n'oubli pas ce post