Sujet Précédent Sujet Suivant

VBA Macro Outlook : Exporter résultats de sondages mails (boutons de vote)

Fermé
vn9596 Messages postés 2 Date d'inscription lundi 13 juillet 2020 Statut Membre Dernière intervention 30 juillet 2020 - Modifié le 13 juil. 2020 à 14:10
vn9596 Messages postés 2 Date d'inscription lundi 13 juillet 2020 Statut Membre Dernière intervention 30 juillet 2020 - 30 juil. 2020 à 07:29
Bonjour à tous,
Novice sur VBA, je me prends à me passionner pour ce monde plein de potentiel, et ce sujet est mon premier que je poste moi-même (habituellement je trouve toutes mes solutions sur la toile, grâce aux forums comme ici, et merci à vous tous au passage).

Contexte:
Je travaille sur Microsoft 365.
Je souhaite mettre en place au moins 2 dispositifs dont le deuxième me paraît le plus dur (et important):

1/ Un mail automatiquement généré destiné à une liste d'adresses avec inclusion d'un bouton de vote ("Valider"/"Refuser" par ex).
Cette liste d'adresses serait référencée dans un classeur Excel et je pensais notamment à du publipostage, mais ne pouvant pas inclure un bouton de vote automatiquement avec le publipostage, je réfléchis à une macro.
J'ai une grossière macro pour la génération de ce mail : 

Sub envoie_mail()
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
Set objOL = New Outlook.Application
Set Msg = objOL.CreateItem(olMailItem)
Msg.To = Email
Msg.Subject = Range("Mail_subject")
Msg.Body = "Hello," & vbNewLine & vbNewLine & _
"Please be informed that Blablabla" & vbNewLine & vbNewLine & _
'Msg.Attachments.Add Source:=nom_doc
Msg.VotingOptions = "Valider;refuser"
Msg.To = Email
Msg.Display
Set objOL = Nothing
End Sub



2/ Je déterre ce sujet d'un autre forum de 2009, correspondant à ce que je cherche, et qui m'a fait avancer, me semble-t-il : https://www.excel-downloads.com/threads/creer-sondage-et-collecter-reponses-mail-outlook-excel.132775/

Je souhaite faire une exportation automatique sur Excel des résultats de vote par mail évoqué ci-avant, et les voir s'afficher et compilés tout propres sur une feuille de calcul, (dans le but de faire des relances automatiques dans un 3ème temps pour ceux qui n'ont pas voté...).

J'ai donc cette macro, qui me sort une "Erreur d'exécution '13' : incompatibilité de type" en me surlignant le "Next" en jaune... 

Sub chMail()
Set olApp = CreateObject("Outlook.application")
Set OLspace = olApp.GetNamespace("MAPI")
Set OLinbox = OLspace.GetDefaultFolder(olFolderInbox)
Dim OLmail As Outlook.MailItem
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
    i = i + 1
Next
End Sub


(Dans un dernier temps, je ne suis pas contre des idées pour organiser les relances de mails si pas de réponses après x jours)

Je précise que je ne comprends évidemment pas tout tout tout des subtilités des lignes de code que je vous écris ici.
Je suis à l'écoute de toute piste intéressante

Merci par avance
A voir également:

1 réponse

Réponse 1 / 1
vn9596 Messages postés 2 Date d'inscription lundi 13 juillet 2020 Statut Membre Dernière intervention 30 juillet 2020
30 juil. 2020 à 07:29
Bonjour

Ayant bénéfié de l'expérience et la gentillesse de quelqu'un sur un autre forum, je publie ici la solution à mon problème.

J'ai donc à présent une fonctionnalité qui semble marcher :

Contexte : "Pro_Name_VX_X_Ref" est le nom donné à ma cellule de choix de référence, une cellule contenant une liste déroulante, avec pour source de celle-ci un tableau (dans un onglet"Liste 000") de l'ensemble des procédures sur lesquelles je souhaite travailler.

Excel va donc chercher les mails avec les votes d'intérêt dans le dossier "Publication" > Pro_Name_VX_X_Ref. 

Function FeuilleExiste(wk As Workbook, stFeuille) As Boolean
On Error Resume Next
FeuilleExiste = Not (wk.Sheets(stFeuille) Is Nothing)
End Function

Sub Votes_import()
Dim Ligne()
Dim olMail As Outlook.MailItem

Set olApp = CreateObject("Outlook.application")
Set olRoot = olApp.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Parent
MsgBox (" Attention, le fichier dans le classeur Publications de Outlook doit avoir exactement le même nom que le doc dans le tableau Liste 000 ! ")
Set OLinbox = olRoot.Folders("Publications").Folders(Range("Pro_Name_VX_X_Ref").Value)

    Application.DisplayAlerts = False
    If FeuilleExiste(ThisWorkbook, Range("Pro_Name_VX_X_Ref").Value) Then
    Sheets(Range("Pro_Name_VX_X_Ref").Value).Delete
    End If
    Worksheets.Add After:=ActiveSheet
    ActiveSheet.Name = Range("Pro_Name_VX_X_Ref").Value
    Application.DisplayAlerts = True

    Sheets(Range("Pro_Name_VX_X_Ref").Value).Cells.Clear
    i = 1
    Ligne = Array("SenderName", "SenderEmailAdress", "ReceivedTime", "VotingResponse")
    Sheets(Range("Pro_Name_VX_X_Ref").Value).Range("F" & i).Resize(, UBound(Ligne) + 1) = Ligne
    Sheets(Range("Pro_Name_VX_X_Ref").Value).ListObjects.Add(xlSrcRange, Sheets(Range("Pro_Name_VX_X_Ref").Value).Range("F1").Resize(, UBound(Ligne) + 1), , xlYes).Name = "Réponses"
    Sheets(Range("Pro_Name_VX_X_Ref").Value).ListObjects("Réponses").TableStyle = "TableStyleMedium2"

    For Each olMail In OLinbox.Items
        With olMail
            If .Subject Like "Read and understood*" Or .Subject Like "Additional info needed*" Then

                i = i + 1
                If .SenderEmailType = "EX" Then
                    SmAdress = .Sender.GetExchangeUser.PrimarySmtpAddress
                Else
                    SmAdress = .SenderEmailAddress
                End If
                Ligne = Array(.SenderName, SmAdress, .ReceivedTime, .VotingResponse)
                Sheets(Range("Pro_Name_VX_X_Ref").Value).Range("F" & i).Resize(, UBound(Ligne) + 1) = Ligne
            End If
        End With
    Next

Set OLinbox = Nothing
Set olRoot = Nothing
Set olApp = Nothing

Sheets(Range("Pro_Name_VX_X_Ref").Value).Activate
Range("Réponses").Sort Key1:=Range("F1"), Header:=xlYes
Sheets(Range("Pro_Name_VX_X_Ref").Value).Columns.AutoFit
End Sub
0

Discussions similaires

Postmaster outlook c'est quoi ???
Jitgie -
Bern -

7 réponses
Erreur d'exécution 13 Incompatibilité de type
grace -
pijaku -

5 réponses