Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1436to1440
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Zellwerte als Ordner erstellen

Zellwerte als Ordner erstellen
14.07.2015 14:58:58
Bernd
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

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Zellwerte als Ordner erstellen
14.07.2015 16:04:02
Michael
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

Anzeige
AW: Zellwerte als Ordner erstellen
14.07.2015 16:08:47
Bernd
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

AW: Ja, melde Dich morgen! Schönen Abend, owT
14.07.2015 16:11:09
Michael
.

AW: Hier noch eine verbesserte Version
14.07.2015 16:45:03
Michael
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

Anzeige
AW: @ Michael
15.07.2015 05:45:17
Bernd
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

Anzeige
AW: So macht Helfen Spaß...
15.07.2015 08:56:18
Michael
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

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige