xlsvbah14.3

Attribute VB_Name = "mod3Antwoorden"

Option Explicit

Dim r As Integer
Dim k As Integer

' Opdracht 1: maak een procedure met het FileSystemObject die hetzelfde resultaat genereerd als oefening 2

Sub Antwoord1()
    
    Dim objFSO As Object
    Dim objMap As Object
    Dim objBestand As Object
    
    Dim i As Integer
    
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objMap = objFSO.getFolder(ActiveWorkbook.Path & "\Bronnen")

    For Each objBestand In objMap.Files
        i = i + 1
        Debug.Print objBestand.Name
    Next

End Sub

' Opdracht 2: maak een procedure met het FileSystemObject die de namen van de submappen (1 niveau) genereerd
'             map   : een niveau hoger dan de huidige map
'             doel  : werkmap i.p.v. direct venster

Sub Antwoord2()

    Dim objFSO As Object
    Dim objMap As Object
    Dim objSubMap As Object
    
    Dim i As Integer
    
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objMap = objFSO.getFolder(ActiveWorkbook.Path)
    Set objMap = objMap.ParentFolder

    For Each objSubMap In objMap.SubFolders
        i = i + 1
        Cells(i, 1) = objSubMap.Name
    Next
    
End Sub

' Opdracht 3: breid opdracht 2 uit met een venster waarbij een map geselecteerd kan worden. Verwijder de regel met de ParentFolder

Sub Antwoord3()

    Dim fdVenster As FileDialog
    Dim strMap As String
    
    Dim objFSO As Object
    Dim objMap As Object
    Dim objSubMap As Object
    Dim objBestand As Object
    
    Dim i As Integer
    
    Set fdVenster = Application.FileDialog(msoFileDialogFolderPicker)
    
    With fdVenster
        .Title = "Selecteer een map"
        If .Show = -1 Then strMap = .SelectedItems(1)
    End With
  
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objMap = objFSO.getFolder(strMap)
    
    For Each objSubMap In objMap.SubFolders
        i = i + 1
        Cells(i, 1) = objSubMap.Name
    Next

End Sub

' Opdracht 4: breid oefening 3 uit zodat de de mappenstructuur hierarchisch in een werkmap wordt gegenereerd

Sub Antwoord4()

    Dim objFSO As Object
    Dim objMap As Object
       
    r = 0
    k = 0
    
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objMap = objFSO.getFolder(ActiveWorkbook.Path)
    Set objMap = objMap.ParentFolder
    
    gaMap objMap

End Sub

Sub gaMap(objMap)

    Dim objSubMap As Object
    Dim objBestand As Object
    
    r = r + 1
    
    For Each objSubMap In objMap.SubFolders
        k = k + 1
        Cells(r, k) = objSubMap.Name
        gaMap objSubMap
    Next
    
    k = k + 1

    For Each objBestand In objMap.Files
        Cells(r, k) = objBestand.Name
        r = r + 1
    Next
    
    k = k - 2

End Sub