29. september 2011 - 09:56
Der er
7 kommentarer og
1 løsning
Liste over Excel filer i folder og subfolder
Hej
Jeg har fundet denne her på nettet men den virker ikke i Excel 2007
pga. Application.FileSearch tror jeg.
Er der nogen der kan hjælpe med at få den tilpasset så jeg kan bruge den.
Jeg ville også meget gerne have filstien med også.
Sub ListAllFiles()
Dim fs As FileSearch, ws As Worksheet, i As Long
Set fs = Application.FileSearch
With fs
.SearchSubFolders = True
.FileType = msoFileTypeExcelWorkbooks
.LookIn = "C:\"
If .Execute > 0 Then
Set ws = Worksheets.Add
For i = 1 To .FoundFiles.Count
ws.Cells(i, 1) = .FoundFiles(i)
Next
Else
Exit sub
End If
End With
End Sub
29. september 2011 - 14:41
#1
Jeg bruger selv denne her, husk at ændre stinavn under "Sub FindFiler () -> Call Listfiler". Håber du kan få glæde af den.
Sub FindFiler()
Application.ScreenUpdating = False
Dim FilTyper() As String
FilTyper = Split("xls,xlsx,xlsm,xltx,xltm,xlt,csv,xla,xlam", ",", , vbTextCompare)
Call ListFiler("H:\", 10, FilTyper)
Application.StatusBar = "Færdig"
Application.ScreenUpdating = True
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)
DoEvents
Application.StatusBar = "Henter: " & OfFolder.Name
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
29. september 2011 - 15:10
#2
Jeg fåren Compile error:
User-defined type not defined
på:
Private Sub HentFiler(ByVal OfFolder As Folder, ByVal fSize As Long, _
ByRef dstRange As Range, ByRef FTypes() As String)
Gør jeg noget forkert ?
29. september 2011 - 15:51
#3
jeg får en Comlie error:
User-defined type not defined
på denne her:
Private Sub HentFiler(ByVal OfFolder As Folder, ByVal fSize As Long, _
ByRef dstRange As Range, ByRef FTypes() As String)
30. september 2011 - 14:04
#6
Fungerer fint hos mig (H-drevet ændret til C-drevet). Ganske nyttig lille ting, der viser, hvor mange Excel-filer, man gennem årene har fået lavet/samlet sammen.
