Opgelost excel kolom omzetten in verkenner folder

Dit topic is als opgelost gemarkeerd
Status
Niet open voor verdere reacties.
H

hein68

Gebruiker
Lid geworden
18 mrt 2016
Berichten
48
Hallo, ik heb weer een vraag met betrekking tot kolomnamen en een map maken met submappen in de verkenner nadat men op de knop opslaan drukt.

in de bijlage zit een excel bestand waar in de kolom a nummers staan. nu komen er steeds nieuwe nummers bij en van elk nummer moet in de verkenner een map gemaakt worden op lokatie d:\dossier\

in deze nieuwe map moeten dan 5 submappen komen te staan 100000\formulier, 100000\bijlage, 100000\foto, 100000\kaart, 100000\andere informatie.

zodra er een nieuw nummer in kolom a wordt toegevoegd zou de via code moeten kijken in d:\dossier of het map met het nummer voorkomt incl submappen en zo ja niets doen maar als deze er niet in staat de map met submappen aanmaken.

Graag uw feedback.
 

Bijlagen

Je hebt een document zonder code geplaatst.
 
Beste Edmoor,

Sorry dat klopt omdat ik zelf nog zoekende in het forum en proberende ben maar de code voor map doorzoeken of iets er is weet ik sowieso (nog) niet.
 
Plaats deze achter Blad1:
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column = 1 Then
        Dim map As String
        map = "D:\dossier\" & Target.Value
        Dim FSO As Object
    
        Set FSO = CreateObject("Scripting.Filesystemobject")
        If Not FSO.folderexists(map) Then
            FSO.createfolder (map)
            FSO.createfolder (map & "\formulier")
            FSO.createfolder (map & "\bijlage")
            FSO.createfolder (map & "\foto")
            FSO.createfolder (map & "\kaart")
            FSO.createfolder (map & "\andere informatie")
            MsgBox "Mappen aangemaakt"
        End If
    End If
End Sub
 
nu komen er steeds nieuwe nummers bij en van elk nummer moet in de verkenner een map gemaakt worden op lokatie d:\dossier\

in deze nieuwe map moeten dan 5 submappen komen te staan 100000\formulier, 100000\bijlage, 100000\foto, 100000\kaart, 100000\andere informatie.
Klik om te vergroten...
Laat het 'papierdenken' achter je.

Gebruik de naam van een bestand om aan te geven waarover het gaat; bijv.
D:\dossier\1000_F_001 (eerste formulier in dossier 1000)
D:\dossier\1000_F_002 (tweede formulier in dossier 1000)
D:\dossier\1002_B_001 (eerste bijlage in dossier 1002)
D:\dossier\1002_B_002 (tweede bijlage in dossier 1002)
D:\dossier\1008_K_001 (eerste kaart in dossier 1008)
D:\dossier\1008_K_001 (tweede kaart in dossier 1008)

deze bestanden kunnen allemaal in dezelfde directory worden opgeslagen en eenvoudig gefilterd.
 
Hoi SNB,

ik begrijp jouw redenering maar in dit geval zijn het ingestuurde documenten die in de map geplaatst moeten worden.

@AHulpje thx ik ga dit testen. alvast bedankt.
 
@AHulpje,

ik heb jou code gebruikt en dit werkt perfect op het moment dat ik een nieuw nummer in kolom a toevoeg. maar de bestaande nummers die er al in staan worden niet aangemaakt.

of werkt de check tussen kolom a en de map nog niet?

dank voor het meekijken
 
ik begrijp jouw redenering maar in dit geval zijn het ingestuurde documenten die in de map geplaatst moeten worden.
Klik om te vergroten...
Dat is geen argument tegen mijn redenering.
 
ok als dit geen argument is dan begrijp ik niet hoe jij dit dan ziet. de aparte bijlagen komen niet in de kolom a dus kan ik deze toch ook niet met VBA naar map transporteren met het volgnummer 00x?

ik ben nog een noob wat dit betreft dus denk vast verkeerd.
 
AHulpje zei:
Plaats deze achter Blad1:
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column = 1 Then
        Dim map As String
        map = "D:\dossier\" & Target.Value
        Dim FSO As Object
    
        Set FSO = CreateObject("Scripting.Filesystemobject")
        If Not FSO.folderexists(map) Then
            FSO.createfolder (map)
            FSO.createfolder (map & "\formulier")
            FSO.createfolder (map & "\bijlage")
            FSO.createfolder (map & "\foto")
            FSO.createfolder (map & "\kaart")
            FSO.createfolder (map & "\andere informatie")
            MsgBox "Mappen aangemaakt"
        End If
    End If
End Sub
Klik om te vergroten...

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim checkRange As Range
    Set checkRange = Range("A1:A1")
    If Not Intersect(Target, checkRange) Is Nothing Then
    
        Dim map As String
        map = "R:\vbadossiers\" & Target.Value
        Dim FSO As Object
    
        Set FSO = CreateObject("Scripting.Filesystemobject")
        
        If Not FSO.FolderExists(map) Then
            FSO.createfolder (map)
            FSO.createfolder (map & "\formulier")
            FSO.createfolder (map & "\bijlage")
            FSO.createfolder (map & "\foto")
            FSO.createfolder (map & "\kaart")
            FSO.createfolder (map & "\andere informatie")
            MsgBox "Mappen aangemaakt"
        End If
    End If
End Sub

ik heb dit geprobeerd om de hele kolom a te checken maar dit werkt niet.
 
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim checkRange As Range
    If Not Intersect(Target, Columns(1)) Is Nothing Then
    
        Dim map As String
        map = "R:\vbadossiers\" & Target.Value
        Dim FSO As Object
    
        Set FSO = CreateObject("Scripting.Filesystemobject")
        
        If Not FSO.FolderExists(map) Then
            FSO.createfolder (map)
            FSO.createfolder (map & "\formulier")
            FSO.createfolder (map & "\bijlage")
            FSO.createfolder (map & "\foto")
            FSO.createfolder (map & "\kaart")
            FSO.createfolder (map & "\andere informatie")
            MsgBox "Mappen aangemaakt"
        End If
    End If
End Sub

heb nu de target range naar kolom 1 aangepast en nu werkt het alleen bij de nieuwe die ingevoerd worden. van de nummers die er al staan worden geen mappen gemaakt. wie weet raad?
 
Lees #5 nog eens rustig door.

Je kunt ieder bestand opslaan met een unieke naam.
Uit de bestandsnaam kun je aflezen om welk dossiernummer het gaat, om wat voor soort document het gaat en om het hoeveelste document in dat dossier het gaat. Dat is minimaal noodzakelijk, maar ook voldoende om ieder document terug te vinden.
Daar zijn geen kasten, planken, ordners, tabbladen voor nodig.
 
Laatst bewerkt:
hein68 zei:
heb nu de target range naar kolom 1 aangepast en nu werkt het alleen bij de nieuwe die ingevoerd worden. van de nummers die er al staan worden geen mappen gemaakt. wie weet raad?
Klik om te vergroten...
Het is natuurlijk onzinnig om bij iedere wiziging in kolom A de hele kolom te controleren.
Gebruik de code die je al kreeg en wijzig eenmalig iedere gevulde cel in kolom A.
 
Laatst bewerkt:
snb zei:
Lees #5 nog eens rustig door.

Je kunt ieder bestand opslaan met een unieke naam.
Uit de bestandsnaam kun je aflezen om welk dossiernummer het gaat, om wat voor soort document het gaat en om het hoeveelste document in dat dossier het gaat. Dat is minimaal noodzakelijk, maar ook voldoende om ieder document terug te vinden.
Daar zijn geen kasten, planken, ordners, tabbladen voor nodig.
Klik om te vergroten...

ok daar heb je gelijk in.

dat betekent dan dat degene die de bijlage binnenkrijgt deze moet hernoemen naar de unieke bestandsnaam en deze in een map te plaatsen waaruit je dan kunt filteren indien je een betreffend document zoekt. bedoel je het ook zo?
 
edmoor zei:
Het is natuurlijk onzinnig om bij iedere wiziging in kolom A de hele kolom te controleren.
Gebruik de code dir je al kreeg en wijzig eenmalig iedere gevulde cel in kolom A.
Klik om te vergroten...

Ik begrijp dat maar er staan er al 500+

is er een code om dat eenmalig aan te controleren en dan aan te maken?
 
Jazeker.
Als je de eerder gekregen code er al in hebt zitten kan je dit doen:
Code: 
Sub Eenmalig()
    For i = 1 To Range("A1").End(xlDown).Row
        Cells(i, 1).Value = Cells(i, 1).Value
    Next i
End Sub
 
Hoi Edmoor

dank je wel,ik heb een module aangemaakt en deze code gedraaid. werkte perfect. dank je
 
Laatst bewerkt:
Hallo allemaal, ik heb in deze thread een vraag gesteld om automatisch mappen te genereren adv kolom in excel. @edmoor heeft mij hier mee geholpen. Nu heb ik ook nog een bestand wat met de aanmaak van de submap daarin gezet moet worden. r:\voorbeeldformat\voorbeeldformat.xls en deze moet in de submap formulier worden geplaatst.

kan dit in deze code toegevoegd worden?

alvast bedank voor de info
 
ik zat hier aan te denken om dat toe te voegen met een ELSE

Set myFile = fSo.CreateTextFile(Folder_path + "\" + Filename, True)

myFile.WriteLine "Error"

myFile.Close

maar helaas lukt mij het niet.
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan