returner alle excelfiler

prøv

Sub Start()
Call ListFilesInFolder("C:\Users\pm\Desktop\", True) ' Indtast sti
End Sub

Sub ListFilesInFolder(ByVal SourceFolderName As String, ByVal IncludeSubfolders As Boolean)
Dim FSO As Object
Dim SourceFolder As Object
Dim SubFolder As Object
Dim FileItem As Object
Dim r As Long
Set FSO = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = FSO.GetFolder(SourceFolderName)
r = Range("A65536").End(xlUp).Row + 1
For Each FileItem In SourceFolder.Files
  If InStr(1, FileItem.Name, ".xls", 1) > 0 Then
  Cells(r, 1).Formula = FileItem.Name
    Cells(r, 2).Formula = FileItem.Path
  r = r + 1
  X = SourceFolder.Path
  End If
Next FileItem
If IncludeSubfolders Then
  For Each SubFolder In SourceFolder.SubFolders
    ListFilesInFolder SubFolder.Path, True
  Next SubFolder
End If
Set FileItem = Nothing
Set SourceFolder = Nothing
Set FSO = Nothing
End Sub

Virker perfekt :-)
Hvor mange point vil du have? Er 60 point ok?

ja det er fint

ekstra point til dig excelent:
http://www.eksperten.dk/spm/918706

Husk at acceptere svaret fra excelent.  :-)