[OL-2010] évènement sur ouverture de mail [Résolu]

[bewidia]

Bonjour,

j'essaie lors de l'ouverture d'un fichier .msg, de le sauvegarder directement en html dans un répertoire donné. Je voudrais ensuite fermer le message (le but est d'automatiser une conversion de .msg en .html en utilisant Outlook)

Après avoir farfouillé sur le net, je suis arrivé à la solution suivante :

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
Public WithEvents VBAInspectors As Inspectors
Public WithEvents VBAInspector As Inspector
Public WithEvents VBAContact As ContactItem
 
Private Sub Initialize_Handler()
Set VBAInspectors = Application.Inspectors
End Sub
 
 
 
 
 
Private Sub Application_Startup()
Initialize_Handler
End Sub
 
 
 
 
Private Sub VBAInspector_Activate()
Set objItem = VBAInspector.CurrentItem
If (objItem.MessageClass = "IPM.Note") Then
Set objCurrentMessage = VBAInspector.CurrentItem
 
NomExport = objCurrentMessage.Subject
repertoire = "C:\Test\"
PathNomExport = repertoire & Left(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
NomExport, "\", ""), "/", ""), ":", ""), "*", ""), "?", ""), "<", ""), ">", ""), "|", ""), ".", ""), """", ""), vbTab, ""), Chr(7), ""), 160) & ".html"
objCurrentMessage.SaveAs PathNomExport, OlSaveAsType.olHTML
 
'objItem.Close olSave
End If
 
 
 
End Sub
 
Private Sub VBAInspectors_NewInspector(ByVal Inspector As Inspector)
Set VBAInspector = Inspector
End Sub

Le problème c'est que l’élèvement survient quand on ferme le mail également, et ça ne m'intéresse pas. J'essaie également de fermer directement le mail avec

Code :

objItem.Close olSave

mais ça ne fonctionne pas (en fait ça ferme le contenu du mail mais la fenêtre avec l'entête reste ouverte).

J'ai essayé d'utiliser

Code :

1
2
3
4
5
6
7
8
9
10
 
Private Sub Application_ItemLoad(ByVal Item As Object)
 
Set objItem = Item
If (objItem.MessageClass = "IPM.Note") Then
 
 
End If
 
End Sub

mais je n'arrive pas à retomber sur le message et le sauvegarder.

Comment faire pour, à l'ouverture d'un mail
- le sauvegarder en HTML
- le fermer

Merci pour votre aide !

[bewidia]

Si ça peut aider quelqu'un, j'ai trouvé une solution

Déclarations

Code :

1
2
3
4
5
 
Dim WithEvents m_objMail As Outlook.MailItem
Dim strPath As String
Dim strFolder As String
Dim objFSO As Object

Evènement d'ouverture d'élément

Code :

1
2
3
4
5
6
7
8
9
10
11
 
Private Sub Application_ItemLoad(ByVal Item As Object)
On Error Resume Next
Dim strClass As String
 
Select Case Item.Class
    Case olMail
        Set m_objMail = Item
End Select
 
End Sub

Quand l'évènement d'ouverture est attrapé et qu'il concerne un olMail, ça appelle directement la méthode m_objMail_Open.

La méthode enregistre le mail ouvert en .html, sauvegarde ses pièces jointes et ferme le mail.

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
 
Private Sub m_objMail_Open(Cancel As Boolean)
    Set objFSO = CreateObject("Scripting.FileSystemObject")
 
    NomExport = m_objMail.Subject
    repertoire = "C:\Test\"
 
    strFolder = repertoire & Left(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
    NomExport, "\", ""), "/", ""), ":", ""), "*", ""), "?", ""), "<", ""), ">", ""), "|", ""), ".", ""), """", ""), vbTab, ""), Chr(7), ""), 160)
 
    strFolder = strFolder & "_piecesjointes"
    If Not (objFSO.FolderExists(strPath)) Then
        objFSO.CreateFolder (strFolder)
    End If
 
    For Each Atmt In m_objMail.Attachments
       FileName = strFolder & "\" & Atmt.FileName
       Atmt.SaveAsFile FileName
       i = i + 1
    Next Atmt
 
    PathNomExport = repertoire & Left(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
    NomExport, "\", ""), "/", ""), ":", ""), "*", ""), "?", ""), "<", ""), ">", ""), "|", ""), ".", ""), """", ""), vbTab, ""), Chr(7), ""), 160) & ".html"
    m_objMail.SaveAs PathNomExport, OlSaveAsType.olHTML
    m_objMail.Close olDiscard
 
End Sub

Inutilisé

Code :

1
2
3
4
 
Private Sub m_objMail_read()
 
End Sub