Her er et bud:
Jeg har lavet det med parametre, så du kan ændre både mappen, og størrelse og filtyper.
Disse funktioner kræver at man kan bruge FileSystemObject.
Så i Visual Basic skal du gå ind i Tools>References... og sikre dig at "Microsoft Scripting Runtime" er vinget af.
Jeg har indsat hyperlinks i kolonne E.
Du skal køre makroen "FindFiler"
Sub FindFiler()
Dim FilTyper() As String
FilTyper = Split("xls,xlsx,xlsm,xltx,xltm,xlt,csv,xla,xlam", ",", , vbTextCompare)
Call ListFiler("c:\dokumenter\", 500, FilTyper)
End Sub
Private Sub ListFiler(ByVal sDir As String, ByVal KBSize As Long, ByRef FilTyper() As String)
Dim ByteSize As Long
ByteSize = KBSize * 1024
Dim FSO As New FileSystemObject
Dim TopFolderObj As Folder
Dim pRange As Range
Set pRange = Range("A1")
Set TopFolderObj = FSO.GetFolder(sDir)
Set pRange = Range("A1")
Call HentFiler(TopFolderObj, ByteSize, pRange, FilTyper)
End Sub
Private Sub HentFiler(ByVal OfFolder As Folder, ByVal fSize As Long, _
ByRef dstRange As Range, ByRef FTypes() As String)
Dim SubFolder As Folder, sFile As File
Dim i As Long, j As Long, sTmp As String
For Each sFile In OfFolder.Files
j = InStrRev(sFile.Name, ".", , vbTextCompare)
sTmp = Right(sFile.Name, Len(sFile.Name) - j)
For i = 0 To UBound(FTypes)
If sTmp = FTypes(i) Then Exit For
Next i
If i < UBound(FTypes) + 1 Then
If sFile.Size >= fSize Then
dstRange.Value = sFile.Name
Set dstRange = dstRange.Offset(0, 1)
dstRange.Value = sFile.DateLastModified
Set dstRange = dstRange.Offset(0, 1)
j = InStrRev(sFile.ParentFolder, "\", , vbTextCompare)
sTmp = Right(sFile.ParentFolder, Len(sFile.ParentFolder) - j)
dstRange.Value = sTmp
Set dstRange = dstRange.Offset(0, 1)
dstRange.Value = sFile.Path
Set dstRange = dstRange.Offset(0, 1)
dstRange.Value = sFile.Path
dstRange.Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
sFile.Path, TextToDisplay:="Åben fil"
Set dstRange = dstRange.Offset(1, -4)
End If
End If
Next sFile
For Each SubFolder In OfFolder.SubFolders
Call HentFiler(SubFolder, fSize, dstRange, FTypes)
Next SubFolder
End Sub
