lien outlook dans excel

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