Discussion :

[vn9596]

Bonjour
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 :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
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 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...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
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

[EricDgn]

Bonjour,

Une autre façon d'écrire les macros:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
Option Explicit
 
Sub envoie_mail()
    Dim olApp As Outlook.Application
    Dim Msg As MailItem
    Set objOL = New Outlook.Application
    Set Msg = objOL.CreateItem(olMailItem)
    With Msg
        .To = Email
        .Subject = Range("Mail_subject")
        .Body = "Hello," & vbCrLf & _
                "Please be informed that Blablabla"
        '.Attachments.Add Source:=nom_doc
        .VotingOptions = "Valider;Refuser"
        .Display
    End With
    Set objOL = Nothing
    Set olApp = Nothing
End Sub
 
Sub chMail()
    Dim olApp As Outlook.Application
    Dim OLspace As Outlook.Namespace
    Dim OLmail As Outlook.MailItem
    Dim OLinbox As Outlook.Folder
    Dim i As Long
    Set olApp = CreateObject("Outlook.application")
    Set OLspace = olApp.GetNamespace("MAPI")
    Set OLinbox = OLspace.GetDefaultFolder(olFolderInbox)
    Sheets("NomOnglet").Select  '<<< à adapter
    i = 1
    For Each OLmail In OLinbox.Items
        With OLmail
            Range("A" & i).Value = .SenderName
            Range("B" & i).Value = .VotingResponse
            Range("C" & i).Value = .CreationTime
            Range("D" & i).Value = .ReceivedTime
            Range("E" & i).Value = .ReadReceiptRequested
        End With
        i = i + 1
    Next
    Set OLinbox = Nothing
    Set OLspace = Nothing
    Set olApp = Nothing
End Sub

... à comprendre avant d'utiliser.
Cordialement.

[vn9596]

Bonjour
Merci bcp à EricDgn d'avoir pris le temps de me corriger,
Je publie ici la solution finale trouvée à mon problème pour ce qui concerne la deuxiè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.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
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