De VBA code genereert een lijst met bestanden in een map. Je kunt zelf een map (directory) kiezen waarvan je de bestanden wil zien.
Voorbeeld weergave:

Voeg onderstaande code toe:
1. Kopieer de onderstaande code middels Ctrl + C
2. Druk op de toetscombinatie ALT + F11 om de Visual Basic Editor te openen
3. Druk op de toetscombinatie ALT + N om het menu Invoegen te openen
4. Druk op M om een standaard module in te voegen
5. Daar waar de cursor knippert voeg je de code in middels Ctrl + V
6. Druk op de toetscombinatie ALT + Q om terug te keren naar het Excel werkblad
7. Tenslotte ga naar View | Macros | View macros en kies je de juiste macro.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 |
Option Compare Text Option Explicit Function Excludes(Ext As String) As Boolean Dim X, NumPos As Long 'Function purpose: To exclude listed file extensions from hyperlink listing '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 Dim SubFolder As Object, Directory As String Dim 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 'Using XL2000+ If Val(Application.Version) > 8 Then .Parent.Hyperlinks.Add Anchor:=.Offset(0, 1), _ Address:=Directory, TextToDisplay:=Directory 'Using XL97 Else .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 'Using XL2000+ If Val(Application.Version) > 8 Then .Hyperlinks.Add _ Anchor:=ActiveSheet.Range("A65536").End(xlUp).Offset(1, _ 0), Address:=File.path, _ TextToDisplay:=File.Name 'Using XL97 Else .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 |