Quelques commandes Vba excel pour piloter Outlook

Version imprimable

29/05/2018, 13h20
scoubi77

Quelques commandes Vba excel pour piloter Outlook

bonjour à tous,

Je recherche quelques instruction pour piloter Outlook depuis un userform dans excel.
J'arrive à récupérer tous les message de ma messagerie dans une listeview, mais je voudrais différencier ceux qui ont été ouvert de ceux qui n'ont pas été ouvert

Y a t'il un moyen de savoir si un mail à déjà été lu ?
Je voudrais afficher le nom du fichier si il y a une pièce jointe.

J'ai trouvé

.Subject
.Body
.SenderName
.CreationTime
i.attachement ? pour une pièce jointe.

Merci à vous tous et bonne journée
29/05/2018, 13h25
kiki29

Salut, voir dans la FAQ
29/05/2018, 15h51
Menhir

Citation:

Envoyé par scoubi77

Je recherche quelques instruction pour piloter Outlook depuis un userform dans excel.

C'est les mêmes que pour piloter Outlook depuis Outlook.

Bonjour et merci pour vos réponses,

J'ai parcouru la FAQ avant de vous solliciter.

Je rencontre pour l"instant deux soucis.
Mon but est de récupérer dans une première intention les messages d'une boite Outlook et de les afficher dans une listeview qui est dans un Userform.
Globalement cela fonctionne, mais je rencontre deux problèmes.
Je voudrais différencier les mail non lus des lus, pour cela j'ai donc écris :

Code:

1
2
3
4
5
6
7
If i.Items.Restrict("[Unread]=true") =True Then
ListView1.ListItems.Add
ListView1.ListItems(n).ListSubItems.Add , , i.Subject, "Img2"
Else
ListView1.ListItems.Add
ListView1.ListItems(n).ListSubItems.Add , , i.Subject, "Img"
End If

le problème est qu 'il ne détecte que en non lus et du coup comme j'ai fabriqué deux icônes pour les différencier !

Mon deuxième problème vient au niveau des pièces jointes, il n'affiche que la première mais plus les autres !

Code:

1
2
3
4
5
6
7
8
If i.Attachments(n) = Empty Then
 b = "Vide"
ListView1.ListItems(n).ListSubItems.Add , , b
Else
b = i.Attachments(n)
 ListView1.ListItems(n).ListSubItems.Add , , b, "Img4"
End If
  Set pceJointe = Nothing

Voici mon code en entier :

Code:

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
60
61
62
63
64
65
66
67
68
69
70
71
72
Sub LitMessagerie()
  Dim OLmail 'As Outlook.MailItem
Dim pceJointe As Outlook.Attachment
 
  Set olApp = CreateObject("Outlook.Application")
  Set olns = olApp.GetNamespace("MAPI")
  Set olxFolder = olns.GetDefaultFolder(6)
On Error Resume Next
 Application.ScreenUpdating = False
 With ListView1
ImageList1.ListImages.Clear
.Gridlines = True
.MultiSelect = True
    ImageList1.ImageHeight = 20 'Hauteur
    ImageList1.ImageWidth = 20 'Largeur
répertoirePhoto = ThisWorkbook.Path
c = "mail1"
d = "mail2"
e = "mail4"
ImageList1.ListImages.Add , "Img", LoadPicture(répertoirePhoto & "\" & c & ".JPG")
ImageList1.ListImages.Add , "Img2", LoadPicture(répertoirePhoto & "\" & d & ".JPG")
ImageList1.ListImages.Add , "Img4", LoadPicture(répertoirePhoto & "\" & e & ".JPG")
 'Set Me.ListView1.ColumnHeaderIcons = ImageList1
    '-------------------------------------------
    Set ListView1.SmallIcons = ImageList1
    Set ListView1.Icons = ImageList1
    '-------------------------------------------
Set ListView1.ColumnHeaderIcons = ImageList1
ListView1.CheckBoxes = True
With .ColumnHeaders
            .Clear
            .Add , , "", 15
            .Add , , "Sujet", 150
            .Add , , "Corps", 100
            .Add , , "Expéditeur", 90
            .Add , , "Date", 60
            .Add , , "Pièces jointes", 90
        End With
End With
n = 1
For Each i In olxFolder.Items
If i.Items.Restrict("[Unread]=true")=True  Then
ListView1.ListItems.Add
ListView1.ListItems(n).ListSubItems.Add , , i.Subject, "Img2"
Else
ListView1.ListItems.Add
ListView1.ListItems(n).ListSubItems.Add , , i.Subject, "Img"
End If
ListView1.ListItems(n).ListSubItems.Add , , i.Body
 If i.SenderName = "" Then
 a = "xxx@xxx.fr"
 Else
 a = i.SenderName
 End If
 ListView1.ListItems(n).ListSubItems.Add , , a
 ListView1.ListItems(n).ListSubItems.Add , , i.CreationTime
  Set pceJointe = i.Attachments(n)
 If i.Attachments(n) = Empty Then
 b = "Vide"
ListView1.ListItems(n).ListSubItems.Add , , b
Else
b = i.Attachments(n)
 ListView1.ListItems(n).ListSubItems.Add , , b, "Img4"
'MsgBox i.Attachments
End If
  Set pceJointe = Nothing
n = n + 1
Next i
'ListView1.View = lvwIcon
ListView1.View = lvwReport
Application.ScreenUpdating = True
End Sub

Merci par avance pour vos aides

Bon j'ai réussi concernant les non lus !

J'ai modifié comme ceci
Code:

1 2 3 4 5 6 7 If i.UnRead(n) = True Then ListView1.ListItems.Add ListView1.ListItems(n).ListSubItems.Add , , i.Subject, "Img2" Else ListView1.ListItems.Add ListView1.ListItems(n).ListSubItems.Add , , i.Subject, "Img" End If
Il me reste les pièces jointes !

Pourquoi ne trouve t'il que la première ?????
pour les autres dans la boucle il ne les voient pas alors qu'elles existent !
Code:

1 2 3 4 5 6 7 8 9 Set pceJointe = i.Attachments(n) If pceJointe = "" Then b = "Vide" ListView1.ListItems(n).ListSubItems.Add , , b Else b = pceJointe ListView1.ListItems(n).ListSubItems.Add , , b, "Img4" End If Set pceJointe = Nothing
Si vous avez des idées ze suis preneur je continu à chercher de mon coté !

c'est bon j'ai réussi

voici mon nouveau code :

Code:

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
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
  Dim OLmail 'As Outlook.MailItem
Dim pceJointe As Outlook.Attachment
 
  Set olApp = CreateObject("Outlook.Application")
  Set olns = olApp.GetNamespace("MAPI")
  Set olxFolder = olns.GetDefaultFolder(6)
On Error Resume Next
 Application.ScreenUpdating = False
 With ListView1
ImageList1.ListImages.Clear
.Gridlines = True
.MultiSelect = True
    ImageList1.ImageHeight = 20 'Hauteur
    ImageList1.ImageWidth = 20 'Largeur
répertoirePhoto = ThisWorkbook.Path
c = "mail1"
d = "mail2"
e = "mail4"
ImageList1.ListImages.Add , "Img", LoadPicture(répertoirePhoto & "\" & c & ".JPG")
ImageList1.ListImages.Add , "Img2", LoadPicture(répertoirePhoto & "\" & d & ".JPG")
ImageList1.ListImages.Add , "Img4", LoadPicture(répertoirePhoto & "\" & e & ".JPG")
    '-------------------------------------------
    Set ListView1.SmallIcons = ImageList1
    Set ListView1.Icons = ImageList1
    '-------------------------------------------
Set ListView1.ColumnHeaderIcons = ImageList1
ListView1.CheckBoxes = True
With .ColumnHeaders
            .Clear
            .Add , , "", 15
            .Add , , "Sujet", 150 ', , "Img"
            .Add , , "Corps", 100
            .Add , , "Expéditeur", 90
            .Add , , "Date", 60
            .Add , , "Pièces jointes", 90 ', , "Img4"
        End With
End With
n = 1
Cont1 = 0
Cont2 = 0
For Each i In olxFolder.Items
If i.UnRead(n) = True Then
ListView1.ListItems.Add
ListView1.ListItems(n).ListSubItems.Add , , i.Subject, "Img2"
Cont1 = Cont1 + 1
Else
ListView1.ListItems.Add
ListView1.ListItems(n).ListSubItems.Add , , i.Subject, "Img"
Cont2 = Cont2 + 1
End If
ListView1.ListItems(n).ListSubItems.Add , , i.Body
 If i.SenderName = "" Then
 a = "Inconnu"
 Else
 a = i.SenderName
 End If
 ListView1.ListItems(n).ListSubItems.Add , , a
 ListView1.ListItems(n).ListSubItems.Add , , i.CreationTime
  If Not i.Attachments.Count = 0 Then
                For y = 1 To i.Attachments.Count
                     Set pceJointe = i.Attachments(y)
                    MsgBox pceJointe.Filename
              Next y
End If
Set pceJointe = i.Attachments(n)
 If pceJointe = "" Then
 b = "Vide"
ListView1.ListItems(n).ListSubItems.Add , , b
Else
b = pceJointe.Filename
 ListView1.ListItems(n).ListSubItems.Add , , pceJointe.Filename, "Img4"
End If
  Set pceJointe = Nothing
  Set i.Attachments(n) = Nothing
n = n + 1
Next i
'ListView1.View = lvwIcon
ListView1.View = lvwReport
UserForm1.Label2.Caption = Cont1
UserForm1.Label3.Caption = Cont2
Application.ScreenUpdating = True

J'ai fait une boucle comme ceci

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
If Not i.Attachments.Count = 0 Then
                For y = 1 To i.Attachments.Count
                     Set pceJointe = i.Attachments(y)
                    MsgBox pceJointe.Filename
              Next y
End If
Set pceJointe = i.Attachments(n)
 If pceJointe = "" Then
 b = "Vide"
ListView1.ListItems(n).ListSubItems.Add , , b
Else
b = pceJointe.Filename
 ListView1.ListItems(n).ListSubItems.Add , , pceJointe.Filename, "Img4"
End If

Merci à tous et bonne journée