Quelques commandes Vba excel pour piloter Outlook

**scoubi77** · 29/05/2018, 13h20

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

**kiki29** · 29/05/2018, 13h25

Salut, voir dans la FAQ

**Menhir** · 29/05/2018, 15h51

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.

**scoubi77** · 30/05/2018, 10h15

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 :

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

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 :

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

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 :

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

**scoubi77** · 30/05/2018, 11h08

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

J'ai modifié comme ceci

Code :

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

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 :

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

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é !

**scoubi77** · 31/05/2018, 08h06

c'est bon j'ai réussi

voici mon nouveau code :

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

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

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

Quelques commandes Vba excel pour piloter Outlook [XL-2007]

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager