Misschien toch voor Excel experts??

[JHM Wetzelaer]

Beste excel-experts,

met veel enthousiasme was het mij d.m.v. ASAP utilities gelukt van een namenlijst in kolom A van excel (met voorletters en geboortedatum) een mappenlijst te maken voor windows (te gebruiken als personeelsdossiers!!), maar helaas lukt het aanmaken van submappen hierin niet zo 1, 2, 3. (zie mijn vraag voor hulp: http://www.helpmij.nl/forum/showthread.php?t=488639).
De volgende (sub-)mappen had ik graag in elk dossier:
- (Her/Over)plaatsen Mobiliteit;
- Beeindiging Dienstverband;
- Belonen, Erkennen;
- Financiele Processen;
- Formatie en Bezetting;
- Indiensttreding, Aanstelling;
- Inzetbaarheid/Verzuim;
- Overige Personeelsadministratie;
- Schorsen, Horen, Bezwaar en Beroep;
- Terugkoppeling Functioneren;
- Training en Opleiding;
- Verlof, Werk- en Rusttijden;
- Werving en Selectie

Is er een mogelijkheid via VBA? Ik heb meerdere "wonderen" van jullie mogen aanschouwen!!

 

[Ginger]

JHM Wetzelaer, Is niet zo'n heel groot probleem voor deze sectie van het forum...

Ik neem aan dat dat namenbestand uit je andere topic DE namen zijn? Dan heb ik die nogmaals overgenomen in de bijlage. Hieruit heb ik alle spaties verwijderd voor een mooie structuur. Vervolgens heb ik hetzelfde gedaan met je lijstje van submappen (en daar tevens de ongeldige tekens verwijderd!!!). Als laatste stap heb ik in cel C1 van de sheet 'Bewerkt' het startpad genoteerd. Jij zal hier zelf het door jullie gebruikte startpad (met aan het einde de backslash >>> VERGEET DIE NIET!!!!) moeten noteren.
Omdat het lastiger is om te gaan kijken welke personeelsmappen er al bestaan, heb ik ervoor gekozen om alles opnieuw aan te laten maken. Gooi dus je eerder aangemaakte mappen weg en druk dan op de knop in de sheet... Als het goed is, ben je dan in een paar seconden klaar!

Groet, Leo

P.s. moest 'm ff zippen ivm de overschrijding van de toegestane hoeveelheid Kb's...

 

[JHM Wetzelaer]

Het werkt!! Joepie. Iedereen die hieraan heeft bijgedragen hartelijk bedankt.

 

[Ginger]

Het werkt!! Joepie. Iedereen die hieraan heeft bijgedragen hartelijk bedankt.

Heu????


Wat ga je nu trouwens met de overgebleven tijd doen, nu je niet al die mapjes handmatig moet aanmaken???

Groet, Leo

 

[JHM Wetzelaer]

Aanpassen van e.e.a.

Excel-fanaten, Leo,

en toen had ik het volgende probleem:
1. de mappen/submappen structuur is uitgevoerd op onze server conform ontworpen door Leo (ik vind het nog steeds fantastisch dat dit kan!!);
2. vooruitlopend op de definitieve invoering van de submappen zijn we toch al begonnen met vulling van de hoofdmap (dus bestanden worden vooralsnog direct achter de hoofdmapnaam gedropt).
3. het besluit is ondertussen gevallen om de submappen toch te gaan veranderen in een eenvoudigere submappenstructuur nl:
Stamkaart;
Rechtspositie;
Salarisgegevens;
Verlofaanvragen;
Sollicitatiegegevens;
Funcioneren;
Ontwikkeling/Mobiliteit

Ik heb alle mappen/submappen (en reeds aanwezige bestanden) weer op mijn USB-stick
geladen en hoop dat jullie mij kunnen helpen met het pobleem "oude submappen verwijderen", nieuwe submappen invoegen" (met behoud van de bestanden die bovenaan in de root staan!!). Is dit mogelijk?

 

[snb]

Mijn voorkeur zou zijn alleen van de namen een map te maken (zonder geboortedatum).

De macro daarvoor is:

Sub tst5()
  With Sheets("origineel")
    For j = 10 To 2 Step -1
      .Columns(1).Replace Space(j), "|"
    Next
    .Columns(1).TextToColumns , , , , , , , , True, "|"
    .Columns(1).Replace Space(1), "_"
  End With
End Sub

zet vervolgens in kolom C de namen van de te maken submappen en in cel D1 de drive +hoofmap ("C:\personeel\")

De macro wordt:

Sub tst()
    Set fs = CreateObject("scripting.filesystemobject")
    sq = sheets("origineel").Columns(1).SpecialCells(2)
    sp = sheets("origineel").Columns(3).SpecialCells(2)
    c2= sheets("origineel").range("D1")

    For Each cl In sq
        If Dir(c2 & cl & "*", vbDirectory) = "" Then
            fs.createfolder c2 & cl
        else
            fs.movefolder c2 & cl & "*",c2 & cl
        end if

        For Each fl In fs.getfolder(c2 & cl).subfolders
            fs.Deletefolder fl
        Next

        For Each mp In sp
            fs.createfolder c2 & cl & "\" & mp
        Next
    Next
End Sub

 

[JHM Wetzelaer]

Bestandje Leo

Ik heb er voor gekozen om wederom het bestandje van Leo uit te voeren, maar helaas het werk nu niet meer bij mij. Ik krijg een foutmelding 75 en lijft staan bij "" If Len(Dir(q3)) = 0 Then MkDir q3 'kijk of de startfolder bestaat..." (is geel gearceerd)

Sub ZonderSpaties()

    q1 = Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)
    
    For i = LBound(q1) To UBound(q1)
        q1(i, 1) = Replace(q1(i, 1), " ", "")
    Next i
    
    Range("A1").Resize(UBound(q1)) = q1

End Sub

Sub MaakMappen()

    q1 = Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)  'de hoofdmappen
    q2 = Range("B1:B" & Cells(Rows.Count, 2).End(xlUp).Row)  'de submappen
    q3 = Range("rngPad").Value
    
    If Len(Dir(q3)) = 0 Then MkDir q3 'kijk of de startfolder bestaat...
    
    For i = LBound(q1) To UBound(q1)
        MkDir q3 & q1(i, 1)
        For x = LBound(q2) To UBound(q2)
            MkDir q3 & q1(i, 1) & "\" & q2(x, 1)
        Next x
    Next i

End Sub

Wat nu?

 

[huijb]

Waarom ben je niet in je eerder gestelde vraag gebleven, zoals je in je link aangeeft in je startpost?

Edit: Ik zie nu dat het onderwerp betrekking had op Windows 7

 

[JHM Wetzelaer]

Bestandje

Het excel bestandje dat nu niet meer functioneert heb ik bijgevoegd

 

[oeldere]

mr Wetzelaer,

zet je vraag even op niet opgelost.

dit kan alleen de vraagsteller.

deze optie zit links- of rechtsonder.

dan zien gebruikers ook dat de vraag nog open staat.

Met vriendelijke groeten,

Oeldere

 

[snb]

Wat nu?

Gebruik deze oplossing

 

[Ginger]

Wat nu?

De error 75 geeft aan dat er een probleem is met het pad dat je opgeeft. ELKE map die je in het pad geeft, moet bestaan! Zo niet... Dan klapt de boel. Controleer deze dus ff...

Groet, Leo

[EDIT] en let vooral op de oplossing van snb!

 

[JHM Wetzelaer]

Lettertje verkeerd getikt, Oeps!!