Macro to make a filenamelist by searching a folder

[Snoopy]

Hey guys
I want to make a list (in Excel)
This list will contain all the filenames (not the filepath) of all my
files in a spesific folder.
Eg. I want to make a macro that copies each filename i the folder and
paste the names in a list.

I really appreciate if anyone would be kindly to help
Regards Snoopy

 

[Bernie Deitrick]

Snoopy,

Put the code below into a codemodule, and save the file in the folder of interest. Then run

ListAllFilesInFolder


HTH,
Bernie
MS Excel MVP


Option Explicit
Sub ListAllFilesInFolder()
Dim i As Integer
With Application.FileSearch
.NewSearch
.LookIn = ThisWorkbook.Path
.FileType = msoFileTypeExcelWorkbooks
.SearchSubFolders = True
If .Execute() > 0 Then
For i = 1 To .FoundFiles.Count
Cells(i, 1).Value = ReturnShortName(.FoundFiles(i))
Next i
Else
MsgBox "There were no matching files found."
End If
End With
End Sub

Function ReturnShortName(inString As String) As String
Dim numSlash As Integer
Dim i As Integer

'Functions takes a path and filename, and
'returns just the filename w/o extension

numSlash = Len(inString) - Len(Application.Substitute(inString, "\", ""))

For i = 1 To numSlash
inString = Right(inString, Len(inString) - InStr(1, inString, "\"))
Next i

ReturnShortName = inString

End Function

 

[Shane Devenshire]

Hi,

Here is some code:

Sub MyFiles()
myFile= Dir("*.xls")
I = 1
Do Until myFile = ""
Cells(I,1) =myFile
I=I+1
myFile = Dir
Loop
End Sub

This is from Reed Jacobson.

 

[Nils Morten]

Snoopy,

Put the code below into a codemodule, and save the file in the folder of interest. Then run

ListAllFilesInFolder

HTH,
Bernie
MS Excel MVP

Option Explicit
Sub ListAllFilesInFolder()
Dim i As Integer
With Application.FileSearch
   .NewSearch
   .LookIn = ThisWorkbook.Path
   .FileType = msoFileTypeExcelWorkbooks
   .SearchSubFolders = True
   If .Execute() > 0 Then
      For i = 1 To .FoundFiles.Count
         Cells(i, 1).Value = ReturnShortName(.FoundFiles(i))
      Next i
   Else
      MsgBox "There were no matching files found."
   End If
End With
End Sub

Function ReturnShortName(inString As String) As String
Dim numSlash As Integer
Dim i As Integer

'Functions takes a path and filename, and
'returns just the filename w/o extension

numSlash = Len(inString) - Len(Application.Substitute(inString, "\", ""))

For i = 1 To numSlash
   inString = Right(inString, Len(inString) - InStr(1, inString, "\"))
Next i

ReturnShortName = inString

End Function







– Vis sitert tekst –

Thanks Bernie
When I try this the macro stops on <With Application.FileSearchwith
the message > and give errormsg: "object doesnt support this action"
What is possible wrong here?
Regards Snoopy

 

[Bernie Deitrick]

Snoopy,

If you are using Excel 2007, they removed FileSearch. But Dir works in any version:

Sub ListAllFilesInFolderWithDir()
Dim WorkFile As String
Dim i As Integer
i = 1
WorkFile = Dir(ThisWorkbook.Path & "\*.xls")
Do While WorkFile <> ""
Cells(i, 1).Value = WorkFile
WorkFile = Dir()
i = i + 1
Loop
End Sub


HTH,
Bernie
MS Excel MVP

Snoopy,

Put the code below into a codemodule, and save the file in the folder of interest. Then run

ListAllFilesInFolder

HTH,
Bernie
MS Excel MVP

Option Explicit
Sub ListAllFilesInFolder()
Dim i As Integer
With Application.FileSearch
.NewSearch
.LookIn = ThisWorkbook.Path
.FileType = msoFileTypeExcelWorkbooks
.SearchSubFolders = True
If .Execute() > 0 Then
For i = 1 To .FoundFiles.Count
Cells(i, 1).Value = ReturnShortName(.FoundFiles(i))
Next i
Else
MsgBox "There were no matching files found."
End If
End With
End Sub

Function ReturnShortName(inString As String) As String
Dim numSlash As Integer
Dim i As Integer

'Functions takes a path and filename, and
'returns just the filename w/o extension

numSlash = Len(inString) - Len(Application.Substitute(inString, "\", ""))

For i = 1 To numSlash
inString = Right(inString, Len(inString) - InStr(1, inString, "\"))
Next i

ReturnShortName = inString

End Function







– Vis sitert tekst –

Thanks Bernie
When I try this the macro stops on <With Application.FileSearchwith
the message > and give errormsg: "object doesnt support this action"
What is possible wrong here?
Regards Snoopy

 

[Nils Morten]

Snoopy,

If you are using Excel 2007, they removed FileSearch. But Dir works in any version:

Sub ListAllFilesInFolderWithDir()
Dim WorkFile As String
Dim i As Integer
i = 1
WorkFile = Dir(ThisWorkbook.Path & "\*.xls")
Do While WorkFile <> ""
Cells(i, 1).Value = WorkFile
   WorkFile = Dir()
   i = i + 1
Loop
End Sub

HTH,
Bernie
MS Excel MVP














Thanks Bernie
When I try this the macro stops on <With Application.FileSearchwith
the message > and give errormsg: "object doesnt support this action"
What is possible wrong here?
Regards Snoopy– Skjul sitert tekst –

– Vis sitert tekst –

Thanks again Bernie!
I have Excel 2007 so .. your second advice was briliant!
This works
Regards Snoopy