Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim OlApp As Object, NS As Object, Dossier As Object
Dim OlExp As Object
Dim i As Object, j As Integer, k As Integer
Cancel = True
Set OlApp = CreateObject("OutLook.Application")
Set fs = CreateObject("Scripting.FileSystemObject")
Set OlExp = OlApp.ActiveExplorer
Set NS = OlApp.GetNamespace("MAPI")
For j = 1 To NS.Folders.Count
Set f = NS.Folders(j)
For k = 1 To NS.Folders(j).Folders.Count
Set Dossier = NS.Folders(j).Folders(k)
For Each i In Dossier.Items
If i.Subject = Target.Value Then
i.display
End If
Next i
Next k
Next j
End Sub