Zellwerte als Ordner erstellen

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
MsgBox
Bild

Betrifft: Zellwerte als Ordner erstellen
von: Bernd
Geschrieben am: 14.07.2015 14:58:58

Wunderschönen guten Tag,
ich habe da eine etwas kompliziertere Frage, und zwar:
Ist es möglich, via VBA, dass mir Excel aus den Zellinhalten F2:F1280, unter dem Pfad D:\FLAG, die dort enthaltenen Zellwerte, es sind Namen, als Ordner erstellen kann?
Dies müsste aber für jeden Zellinhalt ein eigener Ordner sein, also z.B.:
F2 enthält den Text Hubert
F3 enthält den Text Maria
F4 enthält den Text Franz
usw. bis F1280
Nun sollte nach Makroausführung in meinem Ordner (FLAG) für jeden Namen ein eigener leerer Ordner vorhanden sein.
Falls es Doppelnamen gibt, würde es genügen diese einfach, Windowstypisch, mit fortlaufenden Nummern zu versehen, also z.B.: Maria, Maria (1), Maria (2) usw.
Ich denke eine Beispielmappe für mein Problem ist sicher nicht von Nöten da nichts kompliziertes nachgebaut werden muss/soll.
Ich Danke Euch schon mal vorab recht herzlich für Eure Mühen. Sollte es so nicht realisierbar sein, würde ich trotzdem um Mitteilung bitten, dann muss ich die Ordner wohl oder übel, händisch erstellen.
lg aus Kärnten wünscht
Bernd

Bild

Betrifft: AW: Zellwerte als Ordner erstellen
von: Michael (migre)
Geschrieben am: 14.07.2015 16:04:02
Hallo Bernd!
Bspw. so, in ein allgemeines Modul (Alt + F11 in der betr. Mappe, Einfügen... Modul):

Option Explicit
Sub OrdnerStapelanlage()
    Dim Pfad As String
    Dim Namensliste As Range
    Dim Name As Range
    Dim Ordner As String
    Dim i As Integer
    
    'Hauptpfad in dem Ordner angelegt werden sollen
    Pfad = "D:\FLAG"
    'Wo stehen die Ordnernamen
    Set Namensliste = ThisWorkbook.Worksheets("Tabelle1").Range("F2:F1280")
    
    'Ordner nach Liste anlegen, ggf. "hochzählen"
    For Each Name In Namensliste
        Ordner = OrdnerSauber(Name.Value)
        
        If Dir(Pfad & "\" & Ordner, vbDirectory) = "" Then
            MkDir Pfad & "\" & Ordner
        Else:
            i = 1
            Do Until Dir(Pfad & "\" & Ordner & "_" & i, vbDirectory) = ""
                i = i + 1
            Loop
            MkDir Pfad & "\" & Ordner & "_" & i
        End If
    Next
    '[OPTIONAL - ggf. löschen] Hauptpfad nach Stapelanlage öffnen
    Shell "Explorer.exe " & Pfad, vbNormalFocus
End Sub
Function OrdnerSauber(Name As String) As String
'Ordnernamen dürfen nur Buchstaben A-Z inkl. Umlaute enthalten
    Dim i As Integer
    Dim Klar As String
    
    For i = 1 To Len(Name)
        Select Case LCase(Mid(Name, i, 1))
            Case Is = "a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", _
                      "n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z", _
                      "ä", "ö", "ü", "ß"
                Klar = Klar & Mid(Name, i, 1)
            Case Else
                Klar = Klar
        End Select
    Next i
    
    OrdnerSauber = Klar
End Function
Bei Set Namensliste = ... musst Du [Tabelle1] auf Deinen Tabellenblattnamen tauschen.
Passt?
LG
Michael

Bild

Betrifft: AW: Zellwerte als Ordner erstellen
von: Bernd
Geschrieben am: 14.07.2015 16:08:47
Hallo Michael!
ich kann es erst morgen testen, Du bekommst aber sicher dann eine Rückmeldung.
Danke vorerst und schönen Abend wünsche ich,
mfg Bernd

Bild

Betrifft: AW: Ja, melde Dich morgen! Schönen Abend, owT
von: Michael (migre)
Geschrieben am: 14.07.2015 16:11:09
.

Bild

Betrifft: AW: Hier noch eine verbesserte Version
von: Michael (migre)
Geschrieben am: 14.07.2015 16:45:03
Hallo Bernd!
Hier noch eine überarbeitete Version von oben; hier kannst Du den Pfad an dem die Ordner angelegt werden sollen direkt aus einem Dialog wählen (muss also nicht im Makro-Code definiert werden), und der Namensbereich kann variabel lang sein (d.h. es wird das Spaltenende von F:F identifziert), ebenso können nun Leerzeilen vorhanden sein.

Option Explicit
Sub OrdnerStapelanlage()
    Dim Info As String
    Dim Pfad As String
    Dim LeZeile As Long
    Dim Namensliste As Range
    Dim Name As Range
    Dim Ordner As String
    Dim i As Integer
    
    '[OPTIONAL] Benutzer-Info und Abbruchsmöglichkeit
    Info = MsgBox("Für jeden in Spalte F ab Zeile 2 eingetragenen Namen " & _
        "(Zellwert) wird nun ein Ordner in [D:\FLAG] angelegt." & vbCrLf & _
        vbCrLf & "Das kann einige Zeit in Anspruch nehmen. Starten?", vbOKCancel, _
        "Ordner Stapelanlage starten?")
    
    If Info = vbCancel Then Exit Sub
    
    'Hauptpfad in dem Ordner angelegt werden sollen
    Pfad = PfadWahl
    
    'Wenn Namensliste ggf. Leerzeilen enthält
    LeZeile = ThisWorkbook.Worksheets("Tabelle1"). _
        Cells(ThisWorkbook.Worksheets("Tabelle1").Rows.Count, 6).End(xlUp).Row
    
    'Wo stehen die Ordnernamen
    Set Namensliste = ThisWorkbook.Worksheets("Tabelle1").Range("F2:F" & LeZeile)
    
    'Ordner nach Liste anlegen, ggf. "hochzählen"
    For Each Name In Namensliste
        Select Case Name.Value
            Case Is = ""
                'Leere Zellen überspringen
            Case Else
                Ordner = OrdnerSauber(Name.Value)
            
                If Dir(Pfad & "\" & Ordner, vbDirectory) = "" Then
                    MkDir Pfad & "\" & Ordner
                Else:
                    i = 2
                    Do Until Dir(Pfad & "\" & Ordner & "_" & i, vbDirectory) = ""
                        i = i + 1
                    Loop
                    MkDir Pfad & "\" & Ordner & "_" & i
                End If
        End Select
    Next
    
    '[OPTIONAL] Benutzer-Info und Hauptpfad nach Stapelanlage öffnen
    Info = MsgBox("Ordner wurden angelegt. Verzeichnis wird geöffnet... ", vbInformation, _
    "Stapelanlage abgeschlossen!")
    Shell "Explorer.exe " & Pfad, vbNormalFocus
End Sub
Function OrdnerSauber(Name As String) As String
'Ordnernamen dürfen nur Buchstaben A-Z inkl. Umlaute enthalten
    Dim i As Integer
    Dim Klar As String
    
    For i = 1 To Len(Name)
        Select Case LCase(Mid(Name, i, 1))
            Case Is = "a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", _
                      "n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z", _
                      "ä", "ö", "ü", "ß"
                Klar = Klar & Mid(Name, i, 1)
            Case Else
                Klar = Klar
        End Select
    Next i
    
    OrdnerSauber = Klar
End Function
Function PfadWahl() As String
'Verzeichnis, in das Ordner per Stapelanlage erzeugt werden sollen, über
'Datei-Dialog wählen
    Dim SuchDialog As FileDialog
    
    Set SuchDialog = Application.FileDialog(msoFileDialogFolderPicker)
    
    With SuchDialog
        .Title = "Bitte Verzeichnis wählen"
        .AllowMultiSelect = False
        If .Show <> -1 Then
            MsgBox "Vorgang abgebrochen", vbInformation
            Exit Function
        Else: PfadWahl = .SelectedItems(1)
        End If
    End With
    
End Function
Also teste evtl. diesen Code zuerst; Anmerkungen von oben treffen nach wie vor zu.
LG
Michael

Bild

Betrifft: AW: @ Michael
von: Bernd
Geschrieben am: 15.07.2015 05:45:17
Hallo Michael!
ich kann nur sagen WOW und TAUSEND DANK !!!
Dein Code funktioniert einwandfrei. Ich habe, so wie Du vorgeschlagen hast, den zweiten genommen.
Anfangs erhielt ich eine Debuggerwarnung, konnte diese selbst lösen.
Grund war der, dass ich so wie Du geschrieben hast, bei Set Namensliste meinen Blattnamen geändert habe, aber sonst nirgends.
Musste diesen hier:
LeZeile = ThisWorkbook.Worksheets("Tabelle1"). _
Cells(ThisWorkbook.Worksheets("Tabelle1").Rows.Count, 6).End(xlUp).Row
auch ändern, somit erfüllt die Funktion zu 100% meine Wünsche.
Ich sage nochmals ein riesen Dankeschön, Du hast mir sehr viel Arbeit erspart, wünsche Dir und Deinen liebsten alles Gute und viel Glück am weiteren Lebensweg.
Gruß aus Kärnten wünscht der (nun) glückliche
Bernd

Bild

Betrifft: AW: So macht Helfen Spaß...
von: Michael (migre)
Geschrieben am: 15.07.2015 08:56:18
Bernd,
...vielen Dank für Deine äußerst nette Rückmeldung. Super, dass Du Dir bzgl. der Fehlermeldung selbst helfen konntest; hab ich dann vergessen anzumerken!
Dir ebenfalls alles Liebe und viele Grüße zurück aus Wien
Michael

 Bild

Beiträge aus den Excel-Beispielen zum Thema "Zellwerte als Ordner erstellen"