title: excel VBA macro to get list of documents in folder and all subfolders and hyperlink to them
body: <p>I have searched other questions but cant find what I need.
  I have a folder with lost of sub folder, lots of sub folders in them and so on until I get to a list of hundreds of documents in them.</p>
  
  <p>I need a macro in Excel to list the documents in every sub folder of a given directory and also hyperlink to the document.</p>
  
  <p>I have found a macro that will list the documents and create a hyperlink to them in 1 directory but does not delve into the sub directories.</p>
  
  <p>I'm hoping someone can help.</p>
  
  <p>Thanks.</p>
  
  <p>Tom</p>
  
  <p>The macro I am using is:</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")
  
  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
  
   '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, "c:\\")
  
      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
          With .Offset(0, 1)
              .ColumnWidth = 15
              .Value = "Date Modified"
              .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
              End If
               'Add date last modified, and size in KB
              With .Range("A65536").End(xlUp)
                  .Offset(0, 1) = file.datelastModified
  
              End With
          End With
      End If
  Next
  
  End Sub
  </code></pre>
  
  <p>CURRENT UPDATE:
      'Global Declaration for Start Row</p>
  
  <pre><code>Public lngRow As Long
  
  Sub pReadAllFilesInDirectory()
  
  Dim strFolderPath               As String
  Dim BlnInclude_subfolder        As Boolean
  
  'Set Path here
  strFolderPath = "C:\Users\Thomas\Documents\test file"
  
  'set start row
  lngRow = 1
  
  'Set this true if you want list of sub-folders as well
  BlnInclude_subfolder = True
  
  '---------- Reading of files in folders and sub-folders------
  Call ListMyFiles(strFolderPath, BlnInclude_subfolder)
  '---------- Reading of files in folders and sub-folders------
  
  End Sub
  
  Sub ListMyFiles(mySourcePath As String, blnIncludeSubfolders As Boolean)
  
  Dim MyObject            As Object
  Dim mySource            As Object
  Dim mySubFolder         As Object
  Dim myfile              As Object
  Dim iCol                As Long
  
  Set MyObject = CreateObject("Scripting.FileSystemObject")
  Set mySource = MyObject.GetFolder(mySourcePath)
  
  'Loop in each file in Folder
  For Each myfile In mySource.Files
  
    iCol = 1
    Sheet1.Cells(lngRow, iCol).Value = myfile.Name  'File Name
  
  
         ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
      myfile.Path, TextToDisplay:=myfile.Name
  
  
      iCol = iCol + 1
      Sheet1.Cells(lngRow, iCol).Value = myfile.Path  'File Path/Location
     lngRow = lngRow + 1
  
  Next
  
  If blnIncludeSubfolders Then
      For Each mySubFolder In mySource.SubFolders
          Call ListMyFiles(mySubFolder.Path, True)
      Next
  End If
  </code></pre>
  
  <p>THE PROBLEM WITH THE ABOVE IS THE HYPERLINK
  I WANT THE HYPERLINK TO BE IN THE SAME CELL THAT THE NAME OF THE FILE IS IN HOWEVER THE HYPERLINK ENDS UP IN WHAT EVER CELL WAS ACTIVE BEFORE I RAN THE MACRO AND IS THE NAME AND LINK TO THE FINAL FILE FOUND</p>