Discussion :

[Kittenland]

Bonjour

J'ai besoin d'exporter des données de mails au fur et à mesure dans un tableau excel. J'ai déjà bricolé "un truc" en récupérant des bouts de codes en adaptant à mes besoins (au passage merci) qui me permet de presque avoir tout ce que je veux, il me manque une chose, remplis une case avec l'énumération des pièces jointes si elle existe (j'ai tenté des choses avec Attachments mais sans succès).


Merci vraiment, je sèche, je découvre mais ca semble loin de ma portée meme avec les lectures de topic sur ce sujet

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
 
Sub Suivi_Mailout()
    Dim MonOutlook As Outlook.Application
    Dim LeMail As Object
    Dim LesMails As Outlook.Selection
    Set MonOutlook = Outlook.Application
 
    Set LesMails = MonOutlook.ActiveExplorer.Selection
 
    For Each LeMail In LesMails
        EcritDansExcelout LeMail
    Next LeMail
 
    Set LesMails = Nothing
    MsgBox "Fin de traitement"
End Sub
 
 
 
Sub EcritDansExcelout(Optional objCurrentMessage As Object)
Dim XlApp, XlClas
    'Création d'un Excel
    Set XlApp = CreateObject("Excel.Application")
    'Ouverture du classeur
    Set XlClas = XlApp.Workbooks.Open("D:\Suivi\SUIVI_GENERAL.xls")
    'Ecriture d'une valeur en A1 de Feuil1
 
 
 
  With XlClas.Worksheets("class1")
Ligne = .Range("A65536").End(-4162).Row + 1
.Range("A" & Ligne).Value = "Courriel"
.Range("D" & Ligne).Value = objCurrentMessage.EntryID
.Range("E" & Ligne).Value = objCurrentMessage.CreationTime
.Range("G" & Ligne).Value = objCurrentMessage.Sender
.Range("H" & Ligne).Value = objCurrentMessage.To
.Range("L" & Ligne).Value = objCurrentMessage.Subject
.Range("P" & Ligne).Value = objCurrentMessage.Body
 
 
 
 
End With
    'Sauvegarde des modifications et fermeture du classeur
    XlClas.Close True
    'On quitte Excel
    XlApp.Quit
    'On libère la mémoire des variables
    Set XlClas = Nothing
    Set XlApp = Nothing
End Sub

[Oliv-]

Salut,

Voici pour parcourir les PJ

Code :

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

1
2
3
4
5
 
    Dim pj
    For Each pj In objCurrentMessage.Attachments
        MsgBox pj
    Next pj

et là les destinataires

Code :

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

1
2
3
4
Dim Destinataire
    For Each Destinataire In objCurrentMessage.Recipients
        MsgBox Destinataire
    Next Destinataire

Après soit tu mets la listes des PJ dans la même cellule, soit tu octrois des colonnes pour un certains nombre de pj

Code :

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

1
2
3
4
5
6
7
8
9
10
 
 Dim pj
dim lesPJ
lesPJ=""
 
    For Each pj In objCurrentMessage.Attachments
       lesPJ=lesPJ & char(10) & PJ.filename
    Next pj
 
.Range("Q" & Ligne).Value = lesPJ