Sub test()
Dim Win As Object
Dim a As Object
    Set Win = CreateObject("Shell.Application")
    i = 1
    For Each a In Win.NameSpace(4).Items
        If i > 1 Then
            Cells(i, 1) = a.Name
        End If
        i = i + 1
    Next
End Sub