Windows mappen maken met excel

Onlangs moest ik een map maken in windows voor een digitaal dossier. De windows mappen structuur was telkens hetzelfde. 1 hoofdmap met een aantal sub-mappen. De sub-mappen hadden telkens dezelfde naam, alleen de hoofdmap had een afwijkende naam.

Windows mappen maken met excel

Om alles handmatig te doen was onbegonnen werk met zo’n 20.000 records. De informatie kon ik in excel omzetten dus uiteindelijk startte ik de zoektocht naar een macro die daar mappen van zou kunnen maken. En die vond ik!

Data in excel bestand klaar zetten

In het excel bestand moet eerst de data juist gezetten worden. In afbeelding 1 staat hoe ik mijn structuur moest hebben.

Windows mappen maken met excel

Na het uitvoeren van de macro had ik de volgende mappen (afbeelding 2):

Windows mappen maken met excel

Zoals je ziet heb ik hier zelfs nog een sub sub map gemaakt. Hierin kun je doorgaan zolang je wilt. Met deze methode heb ik uiteindelijk een klanten dossier gemaakt en een digitale agenda voor opslaan van gegevens belangrijk voor die datum. Je kunt het bestand uiteraard ook gebruiken voor bijvoorbeeld muziek catalogus, foto’s en documenten.

Zodra je de macro start zal eerst worden gevraagd waar je de mappen wilt opslaan.

Download bron bestand
  mappen-maken-met-excel.xlsm – Bestandsgrootte 16,3 Kb  

De macro’s voor windows mappen

De gehele macro bestaat uit 3 delen.

Gedeelte 1

Sub MappenMakenMetExcel()

 baseFolder = BrowseForFolder
 If (baseFolder = False) Then
 Exit Sub
 End If
 Set fs = CreateObject("Scripting.FileSystemObject")
 For iRow = 1 To 6500
 pathToCreate = baseFolder
 leafFound = False
 For iColumn = 1 To 6500
 currValue = Worksheets(ActiveCell.Worksheet.Name).Cells(iRow, iColumn).Value
 If (currValue = "" And leafFound) Then
 Exit For
 ElseIf (currValue = "") Then
 parentFolder = FindParentFolder(iRow, iColumn)
 If (parentFolder = False) Then
 Exit For
 Else
 pathToCreate = pathToCreate & "\" & parentFolder
 If Not (fs.FolderExists(pathToCreate)) Then
 fs.CreateFolder (pathToCreate)
 End If
 End If
 Else
 leafFound = True
 pathToCreate = pathToCreate & "\" & currValue
 If Not (fs.FolderExists(pathToCreate)) Then
 fs.CreateFolder (pathToCreate)
 End If
 End If
 Next
 If (leafFound = False) Then
 Exit For
 End If
 Next
End Sub

Gedeelte 2

Function FindParentFolder(row, column)
 For iRow = row To 0 Step -1
 currValue = Worksheets(ActiveCell.Worksheet.Name).Cells(iRow, column).Value
 If (currValue <> "") Then
 FindParentFolder = CStr(currValue)
 Exit Function
 ElseIf (column <> 1) Then
 leftValue = Worksheets(ActiveCell.Worksheet.Name).Cells(iRow, column - 1).Value
 If (leftValue <> "") Then
 FindParentFolder = False
 Exit Function
 End If
 End If
 Next
End Function

Gedeelte 3

Function BrowseForFolder(Optional OpenAt As Variant) As Variant
 'Function purpose: To Browser for a user selected folder.
 'If the "OpenAt" path is provided, open the browser at that directory
 'NOTE: If invalid, it will open at the Desktop level

Dim ShellApp As Object

'Create a file browser window at the default folder
 Set ShellApp = CreateObject("Shell.Application"). _
 BrowseForFolder(0, "Please choose a folder", 0, OpenAt)
 'Set the folder to that selected. (On error in case cancelled)
 On Error Resume Next
 BrowseForFolder = ShellApp.self.Path
 On Error GoTo 0

'Destroy the Shell Application
 Set ShellApp = Nothing

'Check for invalid or non-entries and send to the Invalid error
 'handler if found
 'Valid selections can begin L: (where L is a letter) or
 '\\ (as in \\servername\sharename. All others are invalid
 Select Case Mid(BrowseForFolder, 2, 1)
 Case Is = ":"
 If Left(BrowseForFolder, 1) = ":" Then GoTo Invalid
 Case Is = "\"
 If Not Left(BrowseForFolder, 1) = "\" Then GoTo Invalid
 Case Else
 GoTo Invalid
 End Select

Exit Function

Invalid:
 'If it was determined that the selection was invalid, set to False
 BrowseForFolder = False

End Function
Theo Schipper

Dit vind je misschien ook leuk...

8 reacties

  1. Theo schreef:

    Hoi Theo Schipper
    Ik zou in mijn submap een bestand willen zetten. Is dat mogelijk? En weet u hoe dat ik dat dan zou moeten doen?
    Alvast bedankt.

    Gr Theo

  2. Theo Schipper schreef:

    Hoi Eb,

    Maak je gebruik van vreemde tekens in de mapnamen? Het kan zijn dat een map niet gemaakt kan worden omdat Windows de bestandsmap naam niet accepteert namelijk.

    Gr Theo

  3. Jan Hinnen schreef:

    Theo, ik heb het opgelost zat denk ik de naam of structuur van een van de mappen weet het niet precies maar die is nu handmatig aangemaakt. Thx i.i.g.

  4. Jan Hinnen schreef:

    Theo, is heb hetzelfde als Eb, Ik had het werkend maar ineens krijg ik die melding waar kan dat aanliggen denk je. Ik heb ook al een andere computer geprobeerd maar hetzelfde ik krijg de foutmelding.

  5. Jan Hinnen schreef:

    Eb, en Theo is heb precies het zelfde van alles geprobeerd andere computer geprobeerd. Eerst lukt het wel toen eens kwam deze melding.

  6. EB schreef:

    Hoi Theo, als ik de macro start en een map kies krijg ik de MS VBA fout melding dat hij het pad niet kan vinden, Verschillende mappen etc geprobeerd maar krijg het niet werkende, doe ik wat verkeerd?

  7. Theo Schipper schreef:

    Hoi URS,

    Zekers, in het voorbeeld heb de naam Sub map gebruikt, maar in kolom B en C en verder kun je invullen welke mapnaam je ook maar wilt hebben.

    Gr Theo

  8. urs schreef:

    kun je dit ook doen als alle mappen verschillende namen hebben?

Geef een antwoord

Het e-mailadres wordt niet gepubliceerd.