Lag en liste over mapper og undermapper med Microsoft Scripting Runtime

Microsoft Scripting Runtime er inkludert i ett av disse produktene: Windows98, Windows2000, IE5 og Office2000. Eksemplene nedenfor forutsetter at VBA prosjektet har en referanse til Microsoft Scripting Runtime biblioteket. Dette kan gjøres fra VBE ved å velge menyen Verktøy, Referanser (Tools, References) og velge Microsoft Scripting Runtime.

Sub TestListFolders()
    Application.ScreenUpdating = False
    Workbooks.Add ' lager en ny arbeidsbok med mappelisten
    ' add headers
    With Range("A1")
        .Formula = "Mappe innhold:"
        .Font.Bold = True
        .Font.Size = 12
    End With
    Range("A3").Formula = "Mappe sti:"
    Range("B3").Formula = "Mappenavn:"
    Range("C3").Formula = "Størrelse:"
    Range("D3").Formula = "Undermapper:"
    Range("E3").Formula = "Filer:"
    Range("F3").Formula = "Kort navn:"
    Range("G3").Formula = "Kort sti:"
    Range("A3:G3").Font.Bold = True
    ListFolders "C:\FolderName\", True
    Application.ScreenUpdating = True
End Sub

Sub ListFolders(SourceFolderName As String, IncludeSubfolders As Boolean)
' lister informasjon om mapper i SourceFolder
' eksempel: ListFolders "C:\FolderName", True
Dim FSO As Scripting.FileSystemObject
Dim SourceFolder As Scripting.Folder, SubFolder As Scripting.Folder
Dim r As Long
    Set FSO = New Scripting.FileSystemObject
    Set SourceFolder = FSO.GetFolder(SourceFolderName)
    r = Range("A65536").End(xlUp).Row + 1
    Cells(r, 1).Formula = SourceFolder.Path
    Cells(r, 2).Formula = SourceFolder.Name
    Cells(r, 3).Formula = SourceFolder.Size
    Cells(r, 4).Formula = SourceFolder.SubFolders.Count
    Cells(r, 5).Formula = SourceFolder.Files.Count
    Cells(r, 6).Formula = SourceFolder.ShortName
    Cells(r, 7).Formula = SourceFolder.ShortPath
    If IncludeSubfolders Then
        For Each SubFolder In SourceFolder.SubFolders
            ListFolders SubFolder.Path, True
        Next SubFolder
        Set SubFolder = Nothing
    End If
    Columns("A:G").AutoFit
    Set SourceFolder = Nothing
    Set FSO = Nothing
    ActiveWorkbook.Saved = True
End Sub

Dokumentet er sist oppdatert 2005-01-28 17:40:54 Utskriftsvennlig versjon