Excel

Create Hyperlinked List of Directory Contents

Ease of Use

Easy

Version tested with

97, 2000, 2003 

Submitted by:

Ken Puls

Description:

This code creates a hyperlinked list of the contents of a user-specified directory, including the last modified date of the files, and the file size in KB. 

Discussion:

This code gives an easy way to open up a file without having to search through the windows explorer to find it. It will also open virtually any file, xl or not, so can be convenient if you need to launch a Word Document, for example. It also allows certain file extensions to be filtered out, if desired. (Filters out exe, bat, dll & zip files by default) TECHNICAL NOTES (which you can ignore if you want to!) (1) Because the "TextToDisplay" property of a Hyperlink was not added until Office 2000, the appearance of the hyperlinks are less attractive in XL 97 than they are in later versions. In later versions, the hyperlink is masked by the file's name (as it appears in the windows explorer), in XL 97, it shows as the full path to the file. (2) In a Novell Netware environment (and possibly others), the hyperlink maps the UNC path (\\\servername\etc...) to the file, not the short name (j:\etc...) 

Code:

instructions for use

			

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 > 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 <> 0 Then If MsgBox("You did not choose a valid directory!" & vbCrLf & _ "Would you like to try again?", vbYesNoCancel, _ "Directory Required") <> 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) > 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 With .Offset(0, 2) .ColumnWidth = 15 .Value = "File Size (Kb)" .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) > 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 End With End If Next End Sub

How to use:

  1. Copy above code.
  2. In Excel press Alt + F11 to enter the VBE.
  3. Press Ctrl + R to show the Project Explorer.
  4. Right-click desired file on left (in bold).
  5. Choose Insert -> Module.
  6. Paste code into the right pane.
  7. Scroll to find the "Function Excludes" function
  8. Review the line starting "X=Array". Remove any extension you DO want to see in the list, and add any extension you DON'T want to see in the list. (For example if you don't want to see Word documents, add: ,"doc" after the "zip" portion of the line)
  9. Press Alt + Q to close the VBE.
  10. Save workbook before any other changes.
 

Test the code:

  1. Select (or create) a blank worksheet
  2. From Excel, run macro 'HyperlinkFileList' by pressing Alt+F8.
  3. Choose a directory from the explorer window that pops up, and click Okay
  4. If you have not selected a valid directory ('My computer', 'Network Neighborhood', etc...) you will be asked if you would like to try again
  5. Your list will be created
 

Sample File:

Hyperlink Directory Contents.zip 12.3KB 

Approved by mdmackillop


This entry has been viewed 482 times.

Please read our Legal Information and Privacy Policy
Copyright @2004 - 2020 VBA Express