title: Excel VBA: Making a list of all files in a folder, including hyperlinks and copy data from each Excel file it finds
body: <p>My first post here, so be gentle :)</p>
  
  <p>Here is the situation. I'm working on a big softwareproject as a softwaretester. At the moment we are starting with an enormous overhaul of the application wich results in a lot of Excel files with testcases and status reports (over 200 files in the coming months). To follow progress of everything we need an Excelsheet wich can make a list of all the files including hyperlinks and read the status information from each file when it exists.</p>
  
  <p>I've found loads of tutorials on making a list of all the files in a folder and giving them hyperlinks. Currently i'm using the code from this website: <a href="http://www.vbaexpress.com/kb/getarticle.php?kb_id=232" rel="nofollow">http://www.vbaexpress.com/kb/getarticle.php?kb_id=232</a></p>
  
  <p>So now i can make a list of all the files in the folder i can select from a pop-up screen.</p>
  
  <pre><code>Option Compare Text
  Option Explicit
  
  Function Excludes(Ext As String) As Boolean
       'Function purpose:  To exclude listed file extensions from hyperlink listing
  
      Dim X, NumPos As Long
  
       'Enter/adjust file extensions to EXCLUDE from listing here:
      X = Array("exe", "bat", "dll", "zip", "txt", "xlsm", "html", "htm", "xml")
  
      On Error Resume Next
      NumPos = Application.WorksheetFunction.Match(Ext, X, 0)
      If NumPos &gt; 0 Then Excludes = True
      On Error GoTo 0
  
  End Function
  
  
  Sub HyperlinkFileList()
       'Macro purpose:  To create a hyperlinked list of all files in a user
       'specified directory, including file size and date last modified
       'NOTE:  The 'TextToDisplay' property (of the Hyperlink object) was added
       'in Excel 2000.  This code tests the Excel version and does not use the
       'Texttodisplay property if using XL 97.
  
      Dim fso As Object, _
      ShellApp As Object, _
      File As Object, _
      SubFolder As Object, _
      Directory As String, _
      Problem As Boolean, _
      ExcelVer As Integer
  
       'Turn off screen flashing
      Application.ScreenUpdating = False
  
       ' Clear sheet
      Cells.Select
      Selection.Delete Shift:=xlUp
      Range("A1").Select
  
       'Create objects to get a listing of all files in the directory
      Set fso = CreateObject("Scripting.FileSystemObject")
  
       'Prompt user to select a directory
      Do
          Problem = False
          Set ShellApp = CreateObject("Shell.Application"). _
          Browseforfolder(0, "Please choose a folder", 0, "D:")
          'Browseforfolder(0, "Please choose a folder", 0, "D:\JBOSS\Testdossier")
  
          On Error Resume Next
           'Evaluate if directory is valid
          Directory = ShellApp.self.Path
          Set SubFolder = fso.GetFolder(Directory).Files
          If Err.Number &lt;&gt; 0 Then
              If MsgBox("You did not choose a valid directory!" &amp; vbCrLf &amp; _
              "Would you like to try again?", vbYesNoCancel, _
              "Directory Required") &lt;&gt; vbYes Then Exit Sub
              Problem = True
          End If
          On Error GoTo 0
      Loop Until Problem = False
  
       'Set up the headers on the worksheet
      With ActiveSheet
          With .Range("A1")
              .Value = "Listing of all files in:"
              .ColumnWidth = 40
               'If Excel 2000 or greater, add hyperlink with file name
               'displayed.  If earlier, add hyperlink with full path displayed
              If Val(Application.Version) &gt; 8 Then 'Using XL2000+
                  .Parent.Hyperlinks.Add _
                  Anchor:=.Offset(0, 1), _
                  Address:=Directory, _
                  TextToDisplay:=Directory
              Else 'Using XL97
                  .Parent.Hyperlinks.Add _
                  Anchor:=.Offset(0, 1), _
                  Address:=Directory
              End If
          End With
          With .Range("A2")
              .Value = "File Name"
              .Interior.ColorIndex = 15
              .ColumnWidth = 50
              With .Offset(0, 1)
                  .ColumnWidth = 15
                  .Value = "Date Modified"
                  .Interior.ColorIndex = 15
                  .HorizontalAlignment = xlCenter
              End With
              With .Offset(0, 2)
                  .ColumnWidth = 12
                  .Value = "File Size (Kb)"
                  .Interior.ColorIndex = 15
                  .HorizontalAlignment = xlCenter
              End With
              With .Offset(0, 3)
                  .ColumnWidth = 18
                  .Value = "Status testdossier"
                  .Interior.ColorIndex = 15
                  .HorizontalAlignment = xlCenter
              End With
              With .Offset(0, 4)
                  .ColumnWidth = 22
                  .Value = "Totaal aantal testgevallen"
                  .Interior.ColorIndex = 15
                  .HorizontalAlignment = xlCenter
              End With
              With .Offset(0, 5)
                  .ColumnWidth = 15
                  .Value = "Uitgevoerd"
                  .Interior.ColorIndex = 15
                  .HorizontalAlignment = xlCenter
              End With
              With .Offset(0, 6)
                  .ColumnWidth = 15
                  .Value = "Akkoord"
                  .Interior.ColorIndex = 15
                  .HorizontalAlignment = xlCenter
              End With
              With .Offset(0, 7)
                  .ColumnWidth = 6
                  .Value = "OK"
                  .Interior.ColorIndex = 15
                  .HorizontalAlignment = xlCenter
              End With
              With .Offset(0, 8)
                  .ColumnWidth = 6
                  .Value = "NOK"
                  .Interior.ColorIndex = 15
                  .HorizontalAlignment = xlCenter
              End With
          End With
      End With
  
       'Adds each file, details and hyperlinks to the list
      For Each File In SubFolder
              If Not Excludes(Right(File.Path, 3)) = True Then
                  With ActiveSheet
                       'If Excel 2000 or greater, add hyperlink with file name
                       'displayed.  If earlier, add hyperlink with full path displayed
                      If Val(Application.Version) &gt; 8 Then 'Using XL2000+
                          .Hyperlinks.Add _
                          Anchor:=ActiveSheet.Range("A65536").End(xlUp).Offset(1, 0), _
                          Address:=File.Path, _
                          TextToDisplay:=File.Name
                      Else 'Using XL97
                          .Hyperlinks.Add _
                          Anchor:=ActiveSheet.Range("A65536").End(xlUp).Offset(1, 0), _
                          Address:=File.Path
                      End If
                      'Add date last modified, and size in KB
                      With .Range("A65536").End(xlUp)
                          .Offset(0, 1) = File.datelastModified
                          With .Offset(0, 2)
                              .Value = WorksheetFunction.Round(File.Size / 1024, 1)
                              .NumberFormat = "#,##0.0"
                          End With
                      End With
                      'Add Total From this file to current workbook
                      With .Range("A65536").End(xlUp)
                          .Offset(0, 4) = 
  
                      End With
                  End With
              End If
      Next
  
  End Sub
  </code></pre>
  
  <p>I'm having a few problems however :(
  Number one is that it won't exclude all the file extensions i've put in there... for instance .bat won't be selected, but .txt and .xlsm will. Don't know how to fix that.</p>
  
  <p>Number two is, that i just don't know how to copy the information from the excel files that are being listed. I think it has to be done at the following part almost at the bottom "'Adds each file, details and hyperlinks to the list"
  At the last "with" i'm trying to get the data from the file so far i've come up with nothing :( The data i'm trying to fetch are some numbers in a couple of fields on the first sheet of each workbook.</p>
  
  <p>I think the code has to come after ".Offset(0, 4)" but please help me!</p>