Récupèrer un nom de contact

Bonjour,

Je fais appel à votre aide car j'aimerais récupérer un contact dans windows.

Ce contact correspond en fait au user.

J'ai ce code :

Option Explicit

Sub VariablesEnvironnement() 

Dim i As Integer, sEnv As String 

Dim Pos As Integer 

    ActiveWorkbook.Worksheets.Add 

    i = 1 

    Do 

        sEnv = Environ(i) 

        If Len(sEnv) = 0 Then Exit Do 

        Pos = InStr(Environ(i), "=" ) 

        Cells(i, 1) = Left(sEnv, Pos - 1)

        Cells(i, 2) = Right(sEnv, Len(sEnv) - Pos)

        i = i + 1 

    Loop 

Sheets("Feuil1").range("A1").value = Environ ("USERNAME")

End Sub 

Cela fonctionne très bien cependant l'utilisateur ouvre sa session avec un numéro de matricule donc avec ce code je récupére en fait son matricule et non son nom.

C'est pourquoi j'aimerai récupérer le nom du contact afin d'avoir son nom de user.

Le nom de contact se situe à cet emplacement : C:\Users\Mat12345\Contacts

J'ai ce code mais le nom de contact ne s'affiche pas ...

sub contact()

Dim Chemin As String, Fichier As String

    Chemin = "C:\Users\Mat12345\Contacts"

    Fichier = Dir(Chemin & "*.*")

    Do While Len(Fichier) > 0

        MsgBox (Chemin & Fichier)

        Fichier = Dir()

    Loop

    Sheets("Feuil1").Range("A1").Value = Fichier

end sub

Quelqu'un pourrait - il m'aider ?

Merci pour votre temps.