Take a folder of file names and turn the list of file names into a spreadsheet - one row per one file name

[Chrisdudley7]

Does anyone know how to take a list of file names and dump them into an excel spreadsheet as a file name per row? A lot of times I have a folder of 100 or so policies but I want to manage them with a spreadsheet (so I can tie date last reviewed, owner, etc to the policy name) - I wish to avoid clicking, highlighting, copying, and pasting over to a table to make this.

Is there someway in excel to automatically put together a spreadsheet from a directory?

 

[mjbeam]

I have some code in an Excel workbook setup so that if the workbook is saved in a folder, and the macro is executed, all filenames in that folder and any subfolder will be imported into the workbook, one filename (with the full path) per line. Each filename is also hyperlinked so that if you click it the file will be opened.

The code (should be placed in a module):

Private Const vbDot = 46
         
Private Const INVALID_HANDLE_VALUE As Long = -1
Private Const MAX_PATH As Long = 260
Private Const FILE_ATTRIBUTE_READONLY As Long = &H1
Private Const FILE_ATTRIBUTE_HIDDEN As Long = &H2
Private Const FILE_ATTRIBUTE_SYSTEM As Long = &H4
Private Const FILE_ATTRIBUTE_DIRECTORY As Long = &H10
Private Const FILE_ATTRIBUTE_ARCHIVE As Long = &H20
Private Const FILE_ATTRIBUTE_NORMAL As Long = &H80
Private Const FILE_ATTRIBUTE_TEMPORARY As Long = &H100
Private Const FILE_ATTRIBUTE_COMPRESSED As Long = &H800
Private Const FILE_ATTRIBUTE_ALL As Long = FILE_ATTRIBUTE_READONLY Or _
                                           FILE_ATTRIBUTE_HIDDEN Or _
                                           FILE_ATTRIBUTE_SYSTEM Or _
                                           FILE_ATTRIBUTE_ARCHIVE Or _
                                           FILE_ATTRIBUTE_NORMAL Or _
                                           FILE_ATTRIBUTE_COMPRESSED

Private Type FILETIME
   dwLowDateTime As Long
   dwHighDateTime As Long
End Type

Public Type SYSTEMTIME
    wYear As Integer
    wMonth As Integer
    wDayOfWeek As Integer
    wDay As Integer
    wHour As Integer
    wMinute As Integer
    wSecond As Integer
    wMilliseconds As Long
End Type

Private Type WIN32_FIND_DATA
   dwFileAttributes As Long
   ftCreationTime As FILETIME
   ftLastAccessTime As FILETIME
   ftLastWriteTime As FILETIME
   nFileSizeHigh As Long
   nFileSizeLow As Long
   dwReserved0 As Long
   dwReserved1 As Long
   cFileName As String * MAX_PATH
   cAlternate As String * 14
End Type

Private Declare Function FindClose Lib "kernel32" _
  (ByVal hFindFile As Long) As Long
   
Private Declare Function FindFirstFile Lib "kernel32" _
   Alias "FindFirstFileA" _
  (ByVal lpFileName As String, _
   lpFindFileData As WIN32_FIND_DATA) As Long
   
Private Declare Function FindNextFile Lib "kernel32" _
   Alias "FindNextFileA" _
  (ByVal hFindFile As Long, _
   lpFindFileData As WIN32_FIND_DATA) As Long
   
Private Declare Function GetFileAttributes Lib "kernel32" _
   Alias "GetFileAttributesA" _
  (ByVal lpFileName As String) As Long

Private Declare Function lstrlenW Lib "kernel32" _
  (ByVal lpString As Long) As Long
  
Private Declare Function FileTimeToSystemTime Lib "kernel32" _
    (lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME) As Long

Private Declare Function FileTimeToLocalFileTime Lib "kernel32" _
    (lpFileTime As FILETIME, lpLocalFileTime As FILETIME) As Long

Global Next_Available_Row As Integer

Public Sub Start()

    ssource = ThisWorkbook.Path & "\"
    
    Next_Available_Row = 0
    Do
        Next_Available_Row = Next_Available_Row + 1
        DoEvents
    Loop Until Cells(Next_Available_Row, 1) = ""
    
    GetDirectoryContents ssource
    
End Sub

Private Sub GetDirectoryContents(ByVal ssource As String)
   
    Dim wfd As WIN32_FIND_DATA
    Dim hFile As Long
    Dim fCount As Long
    Dim t_attrib As Long
    Dim tstatus As Long
    Dim tsource As String
    Dim Available_Row As Integer
    
    hFile = FindFirstFile(ssource & "*.*", wfd)
    
    If hFile <> INVALID_HANDLE_VALUE Then
    
        Do
       
            t_attrib = GetFileAttributes(ssource & wfd.cFileName)
           
            'Is it a directory?
            If (FILE_ATTRIBUTE_DIRECTORY And t_attrib) And _
                (Asc(wfd.cFileName) <> vbDot) Then
                
                  tsource = Left(wfd.cFileName, InStr(wfd.cFileName, Chr(0)) - 1) & "\"
                  
                  On Error Resume Next
                  Application.StatusBar = "Scanning " & ssource & tsource
                  On Error GoTo 0
                  
                  GetDirectoryContents ssource & tsource
            
            ElseIf (FILE_ATTRIBUTE_ALL And t_attrib) And _
                (Asc(wfd.cFileName) <> vbDot) Then
                
                  temp = ""
                  t = wfd.cFileName
                  i = 1
                  Do
                    If Asc(Mid(t, i, 1)) <> 0 Then temp = temp & Mid(t, i, 1)
                    i = i + 1
                  Loop Until Asc(Mid(t, i, 1)) = 0
                  
                  
                  URL = ssource & temp
            
                  i = 2
                  foundit = False
                  Do
                      If InStr(UCase(URL), UCase(Cells(i, 1))) > 0 And Cells(i, 1) <> "" Then
                          foundit = True
                          Exit Do
                      End If
                      i = i + 1
                  Loop Until Cells(i, 1) = ""
                  
                  If foundit = False Then
                      i = Next_Available_Row
                      Next_Available_Row = Next_Available_Row + 1
                  End If
                 
                  Cells(i, 1).Select
                  ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=URL, TextToDisplay:=URL
                    
            End If
                              
            tstatus = FindNextFile(hFile, wfd)
            
            DoEvents
             
        Loop Until tstatus = 0
       
    End If
    
    'Close the search handle
    Call FindClose(hFile)

End Sub

 

[mjbeam]

If you don't want to bother with macro code, you could also open a command window, navigate to the folder in question and issue a command:

dir > filelist.txt

A file named filelist.txt will be created containing a list of all files in the folder. You could import this file into Excel.

 

[Chrisdudley7]

Both suggestions worked like a charm! Thanks guys - how do I mark this thread as 'solved'?

 

[Ron Coderre]

Perhaps a bit late...but
This code creates a 2-column list in the active sheet
Col_A contains the file path
Col_B contains the file name AND a hyperlink to the referenced file.

Dim iCtr As Integer

Sub ListFolderFiles(strPath As String, IncludeSubFolders As Boolean, StartNew As Boolean)
Dim fso As Object
Dim fStartFolder As Object
Dim fFldr As Object
Dim fFile As Object
Dim cStartCell As Range
Dim cCell As Range
    On Error Resume Next
    If StartNew = True Then
        iCtr = 0
    End If
    Set cStartCell = ActiveCell
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set fStartFolder = fso.GetFolder(strPath)
    
    iCtr = iCtr + 1
    For Each fFile In fStartFolder.Files
        With ActiveSheet
            .Cells(iCtr, 1) = fStartFolder.Path
            .Cells(iCtr, 2) = fFile.Name
            Set cCell = .Cells(iCtr, 2)
            If cCell.Hyperlinks.Count = 0 Then
                On Error Resume Next
                ActiveSheet.Hyperlinks.Add _
                    Anchor:=cCell, _
                    Address:=.Cells(iCtr, 1).Value & "\" & .Cells(iCtr, 2).Value, _
                    TextToDisplay:=cCell.Value
            End If
        End With
        iCtr = iCtr + 1
    Next
    If IncludeSubFolders Then
        For Each fFldr In fStartFolder.SubFolders
            Call ListFolderFiles(fFldr.Path, True, False)
        Next
    End If
End Sub

AND...this code runs that program, passing it the file path to use:

Sub ListMyFolderFiles()
ListFolderFiles strPath:="C:\MyFolder\", IncludeSubFolders:=True, StartNew:=True
End Sub

Is that something you can work with?

 

[Fazza]

FWIW, some code I use. You select the particular files - so may be handy if you don't want all files - you want & the list goes to a new workbook. cheers

Sub ListFiles()


    Dim i                                         As Long
    Dim ar                                        As Variant
    Dim varFileNames                              As Variant
    Dim wks                                       As Excel.Worksheet


    varFileNames = Application.GetOpenFilename(FileFilter:="All Files (*.*),*.*", FilterIndex:=5, Title:="Select Files", MultiSelect:=True)
    If IsArray(varFileNames) Then
        Set wks = Workbooks.Add(Template:=xlWBATWorksheet).Worksheets(1)
        For i = LBound(varFileNames) To UBound(varFileNames)
            ar = Split(varFileNames(i), "\")
            wks.Cells(i, 1).Value = ar(UBound(ar))
        Next i
        Erase ar, varFileNames
        With wks.Range("A1")
            .Sort Key1:=wks.Range("A1"), Order1:=xlAscending, Header:=xlNo
            With .EntireColumn
                .AutoFit
                .ColumnWidth = .ColumnWidth + 6
            End With
        End With
        Set wks = Nothing
    End If
End Sub