créer sondage et collecter reponses mail outlook excel

[nina71287]

Bonsoir,

je cherche à réaliser un demande de congés par mail depuis excel. la personne recevrait le mail aurait le choix entre accepter ou refuser, la réponse serait envoyé dans un fichier excel. j'ai cherché mais je n'ai pas trouvé de solution pour collecter les réponses. J'arrive à afficher les boutons mais pas à recupérer la réponse.J'aurais d'une grande aide à ce sujet cela fait un moment que je n'avance pas merci d'avance

Sub mail()

'--- Envoi par mail
Dim olapp As Outlook.Application
Sheets("destinataires").Select
Range("A11").Select
Do While Not IsEmpty(ActiveCell)
Dim msg As MailItem
Set olapp = New Outlook.Application
Set msg = olapp.CreateItem(olMailItem)
msg.To = ActiveCell.Value
msg.Subject = Range("A2").Value
msg.Body = Range("A5").Value & Chr(13) & Chr(13) & Range("A8").Value & Chr(13) & Chr(13)
msg.Send
msg.votingoptions="approuver;refuser"
Loop
End Sub

 

[nina71287]

Re : créer sondage et collecter reponses mail outlook excel

Merci pr ta reponse.mais je dois absolument passé par oulook si c'est possible il ne faut pas avoir à ouvrir de formulaire juste à cliquer sur un bouton.je n'ai pas compris ce que c'etait les classeurs partagés? merci bonne journée

 

[nina71287]

Re : créer sondage et collecter reponses mail outlook excel

Bonsoir,

Voici mon code sur lequel je bloque il envoie une demande congés a une personne (le referent) pour validation et j'ai reussi à recuperer la reponse sur excel

Dim olApp As Outlook.Application
Dim OLspace As Outlook.Namespace
Dim OLinbox As Outlook.MAPIFolder
Dim OLfolder As Outlook.MAPIFolder
Dim OLmail As Outlook.MailItem
Dim OLpj As Outlook.Attachment
Dim Msg As MailItem
Sub envoie_mail()
Set olApp = New Outlook.Application
Set Msg = olApp.CreateItem(olMailItem)
Msg.To = email
Msg.Subject = "Demande de congés"
Msg.Body = "Veuillez trouver ci joint la demande de congés du 01/01/2009 au 12/01/2009"
'Msg.Attachments.Add Source:=nom_doc
Msg.VotingOptions = "Valider;refuser"
Msg.To = Email
Msg.Display
Set olApp = Nothing
MsgBox "Message envoyé"
chMail
End Sub
Private Sub chMail()
Set olApp = CreateObject("Outlook.application")
Set OLspace = olApp.GetNamespace("MAPI")
Set OLinbox = OLspace.GetDefaultFolder(olFolderInbox)
i = 2
For Each OLmail In OLinbox.Items
If OLmail.Subject = "Valider: " Then
Dim OLbody As String
OLbody = OLmail.SenderName
olresponse = OLmail.VotingResponse
oltime = OLmail.CreationTime
olrecus = OLmail.ReceivedTime
olreceipt = OLmail.ReadReceiptRequested
Sheets(1).Range("A" & i).Select
With Selection
.Value = OLbody
End With
Sheets(1).Range("B" & i).Select
With Selection
.Value = olresponse
End With
Sheets(1).Range("C" & i).Select
With Selection
.Value = oltime
End With
Sheets(1).Range("D" & i).Select
With Selection
.Value = olrecus
End With
Sheets(1).Range("E" & i).Select
With Selection
.Value = olreceipt
End With
ElseIf OLmail.Subject = "Refuser: " Then
OLbody = OLmail.SenderName
olresponse = OLmail.VotingResponse
oltime = OLmail.CreationTime
olrecus = OLmail.ReceivedTime
Sheets(1).Range("A" & i).Select
With Selection
.Value = OLbody
End With
Sheets(1).Range("B" & i).Select
With Selection
.Value = olresponse
End With
Sheets(1).Range("C" & i).Select
With Selection
.Value = oltime
End With
Sheets(1).Range("D" & i).Select
With Selection
.Value = olrecus
End With
Sheets(1).Range("E" & i).Select
End If
Next
i = i + 1
End Sub


Ce que je souhaiterai faire c'est une fois que le mail est envoyé avec un bouton réponse au referent et qu'il valide ou refuse qu'il soit automatiquement envoyé à son supérieur et a l'agent qui avait fait la demande.

Est ce que quelqu'un peut m'aider à améliorer mon code je pensais à l'utilisation d'un evenement sur les boutons reponses mais je ne trouve pas.
merci pour votre aide bonne soirée