Discussion :

[alexis1191]

Bonjour,

Voilà mon problème, je débute en VBA. Je souhaiterai récupérer différentes infos de plusieurs fichiers .msg que j'ai enregistré dans mes Documents.
Voici les infos dont j'ai besoin :
- une information qui se situe dans l'expéditeur du mail.
- une information qui se situe dans l'objet du mail.
- la date du mail
Une fois ces infos récupérées, il faudrait que je puisse les insérer dans mon fichier excel. Chaque information doit être dans une colonne en commençant par A1, B1, C1 etc ...
Est ce que quelqu'un pourrai me dire comment je peux faire ?

Merci d'avance

Alexis

[pijaku]

Bonjour,

Voici un exemple de code qui, semble t'il, fait ce que tu désires.
1- copie/colle ce code dans un Module de ton classeur (depuis la feuille Excel : Alt+F11, puis, sous l'éditeur, Insertion/Module)
2- Adapter ce qui doit l'être (indiqué dans les commentaires)
3- coche la référence à Outlook (sous l'éditeur : Outils/références, chercher et cocher : Microsoft Outlook X.0 Object Library (le x dépend de ta version...))
4- teste...

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
Option Explicit
 
Type Infos
    Objet As String
    Expediteur As String
    Date As String
End Type
 
Sub Cherche_Infos()
Dim Chemin As String, Fichier As String, Extens As String, Inf As Infos, TablInfos() As String, i As Long
Dim objOL As Outlook.Application
'nécessite d'activer la référence : Microsoft Outlook X.0 Object Library.
    Set objOL = CreateObject("Outlook.Application")
    Chemin = "C:\Users\" & Environ("UserName") & "\Desktop\"           '***************** A ADAPTER *****************
    Extens = "*.msg"
    Fichier = Dir(Chemin & Extens)
    If Fichier <> vbNullString Then
        Do
            i = i + 1
            ReDim Preserve TablInfos(1 To 3, 1 To i)
            Inf = ExtraitInfos(Fichier, objOL)
            TablInfos(1, i) = Inf.Objet
            TablInfos(2, i) = Inf.Expediteur
            TablInfos(3, i) = Inf.Date
            Fichier = Dir
        Loop While Fichier <> vbNullString
    End If
    Worksheets("Feuil1").Range("A1").Resize(UBound(TablInfos, 2), 3) = Application.Transpose(TablInfos)           '***************** A ADAPTER *****************
    Set objOL = Nothing
End Sub
 
Function ExtraitInfos(Fichier As String, obj As Outlook.Application) As Infos
Dim Msg As Outlook.MailItem
    Set Msg = obj.Session.OpenSharedItem(Fichier)
    ExtraitInfos.Objet = Msg.Subject
    ExtraitInfos.Expediteur = Msg.SenderEmailAddress 'ou : Msg.SenderName  'ou : Msg.Sender           '***************** A ADAPTER *****************
    ExtraitInfos.Date = Msg.CreationTime
    Set Msg = Nothing
End Function

[mfoxy]

Bonsoir,

+1 Pikaju (salut) pour le typage, trop peu vu sur le forum et pourtant améliore tellement la lisibilité d'un code.

[alexis1191]

Bonjour,

Merci pour les retours.
J'ai trouvé un autre moyen de le faire avec l'option left et mid.
Par exemple :

Code :

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

range("a1").value = Mid(MessageSentOnBehalfOfName, 1, 6)

Ca fonctionne bien.

Par contre, je rencontre un nouveau problème, Comment je peux faire pour extraire la date d'envoie d'un mail.
J'ai fais Message.CreationTime mais ça me donne 01/01/4501.

Est ce que quelqu'un à une idée ?

Alexis