XL 2013 extraction détails du répertoire vers excel

Private Sub test()
    Cells.Delete
    Set fso = CreateObject("Scripting.FileSystemObject")
        With fso.GetFolder("......................") 'Liste les fichiers du répertoire
            [A1].Resize(, 4) = Array("Nom", "Octets", "K Octets", "M Octets")
            [A1].Offset(1).Select
            On Error Resume Next
            For Each File In .Files
                Selection = File.Name 'Place leurs noms ds le document
                Selection.Offset(, 1) = File.Size
                Selection.Offset(, 2) = Application.WorksheetFunction.Round(File.Size / 1024, 0)
                Selection.Offset(, 3) = Application.WorksheetFunction.Round(File.Size / 1024 ^ 2, 2)
                ActiveCell.Offset(1).Select
            Next
        End With
    Set fso = Nothing
    Columns.AutoFit
End Sub

Sub Durée()
    MsgBox Get_Info(27, ".....nom du fichier avec son dossier....")
End Sub
Function Get_Info(Id As Integer, ByVal File)
    Dim oFolder As Object, I As Integer
    I = Len(File) - InStr(1, StrReverse(File), "\", vbTextCompare)
    Set oFolder = CreateObject("Shell.Application").Namespace(Left(File, I))
        Get_Info = oFolder.GetDetailsOf(oFolder.Items.Item(Mid(File, I + 2)), Id)
    Set oFolder = Nothing
End Function