Bestandsnaam naar Excel kopieren.

Option Base 1

Sub GetFilenames()
    Files = Split(CreateObject("WScript.Shell").Exec("cmd /c dir /b C:\Users\Schelledraaad\Documents\*.xls*").StdOut.ReadAll, vbCr)
    For i = 1 To UBound(Files)
        Cells(i, 1) = Files(i)
    Next i
    Range("A1:A" & i).WrapText = False
    Columns.AutoFit
End Sub

Dim ar() As Variant, x As Long

Public Sub file_search()
 On Error Resume Next
 getFile "C:\Users\Schelledraaad\Documents\"
 Cells(1, 1).Resize(x) = Application.Transpose(ar)
 End
End Sub

Public Sub getFile(objFolderPath As String)
 Dim sFold, it, sf
 With CreateObject("scripting.filesystemobject")
    Set sFold = .GetFolder(objFolderPath)
    For Each it In sFold.Files
       If .GetExtensionName(it) Like "xls*" Then
          ReDim Preserve ar(x)
          ar(x) = it.Path
          x = x + 1
       End If
    Next
    For Each sf In sFold.SubFolders
       getFile sf.Path
    Next
 End With
End Sub

Sub GetFilenames()
    Files = Split(CreateObject("WScript.Shell").Exec("cmd /c dir /b C:\Users\Schelledraad\Documents\*.xls*").StdOut.ReadAll, vbCr)
    With Range("A1:A" & UBound(Files))
        .Value = Application.Transpose(Files)
        .WrapText = False
    End With
    Columns.AutoFit
End Sub

Cells.Replace What:=vbLf, Replacement:="", LookAt:=xlPart