Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1828to1832
1828to1832
Aktuelles Verzeichnis
Verzeichnis Übersicht
Verzeichnis Übersicht
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Ordner und Unterordner per Makro anlegen

Forumthread: Ordner und Unterordner per Makro anlegen

Ordner und Unterordner per Makro anlegen
06.05.2021 11:53:41
Thomas
Hallo liebes Forum.
Ich bin seit Jahren treuer Leser und habe hier immer Lösungen oder Ideenansätze für meine Probleme gefunden...und konnte diese dann auch immer lösen.
Vielen Dank einfach mal in diese kompetente Runde an dieser Stelle.
Leider komme ich aktuell nicht weiter.
Folgendes Problem stellt sich mir.
Zielordner auf dem Desktop wäre: "Bauprojekte"
Ich habe eine Datei, in welcher in Spalte "A" die Namen von Orten stehen. Das sind so ca. 12000 Stück.
In Spalte "B" habe ich zu den Orten dann die Straßennahmen stehen.
Es kann aber sehr wohl vorkommen, dass in Spalte "A" z.B. 50x Berlin steht und natürlich in Spalte "B" dann 50 Straßen zu Berlin.
Mein Ziel wäre nun, dass das Makro mir im bereits existierenden Oberordner "Bauprojekte" EINEN Ordner "Berlin" anlegt und im Ordner "Berlin" dann jeweils einen Unterordner mit dem Straßennamen aus Spalte "B" angelegt wird.
Ich hoffe, ich habe mich verständlich ausdrücken können und Ihr könnt mir kurz helfen.
Bei Rückfragen bitte immer gern.
Vielen Dank vorab.
Thomas
Anzeige

9
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Ordner und Unterordner per Makro anlegen
06.05.2021 12:15:36
Nepumuk
Hallo Thomas,
und die Daten beginnen in Zeile?
Gruß
Nepumuk
AW: Ordner und Unterordner per Makro anlegen
06.05.2021 12:16:59
Thomas
Oh sorry, A1 die Orte und B1 die Straßennamen.
Sorry for the missing information.
AW: Ordner und Unterordner per Makro anlegen
06.05.2021 12:46:06
Nepumuk
Hallo Thomas,
teste mal:
Code:



[Cc][+][-]







	
	
	
	




Option Explicit

Private Declare PtrSafe Function MakeSureDirectoryPathExists Lib "imagehlp.dll" ( _
        ByVal DirPath As String) As Long


Public Sub CreateFolders()

  Dim avntFolders As Variant
  Dim ialngIndex As Long
  Dim strTown As String, strMainFolder As String
  Dim lngReturn As Long

  strMainFolder = Environ$("ONEDRIVE") & "\Desktop\Bauprojekte\"

'    strMainFolder = Environ$("USERPROFILE") & "\Desktop\Bauprojekte\"

  avntFolders = Range(Cells(1, 1), Cells(Rows.Count, 2).End(xlUp)).Value2

  For ialngIndex = LBound(avntFolders, 1) To UBound(avntFolders, 1)

      If strTown <> avntFolders(ialngIndex, 1) Then

         strTown = avntFolders(ialngIndex, 1)

         lngReturn = MakeSureDirectoryPathExists(strMainFolder & strTown & "&bsol;")

         If lngReturn = 0 Then

            Call MsgBox("Fehler beim anlegen des Ordners " & strTown, vbCritical, "Programmabbruch")
            Exit Sub

         End If
      End If

      lngReturn = MakeSureDirectoryPathExists(strMainFolder & strTown & "&bsol;" & avntFolders(ialngIndex, _
                2) & "&bsol;")

      If lngReturn = 0 Then

         Call MsgBox("Fehler beim anlegen des Ordners " & avntFolders(ialngIndex, 2), vbCritical, "Programmabbruch") _
              
         Exit Sub

      End If
  Next
End Sub
Für eine dieser zwei Zeilen musst du dich entscheiden:
strMainFolder = Environ$("ONEDRIVE") & "\Desktop\Bauprojekte\"
strMainFolder = Environ$("USERPROFILE") & "\Desktop\Bauprojekte\"
je nachdem ob dein Desktop, wie bei mir, auf OneDrive liegt oder nicht.
Es löst keinen Fehler aus wenn du die Prozedur öffters startest. Die Ordner werden nicht mehrmals angelegt!
Gruß
Nepumuk
Anzeige
AW: Ordner und Unterordner per Makro anlegen
06.05.2021 13:32:39
Thomas
Hallo Nepumuk.
DU BIST EIN GOTT!
Vielen Dank.
Ich habe, da der Ordner bei mir auf dem Desktop liegt, strMainFolder = Environ$("USERPROFILE") & "\Desktop\Bauprojekte\" her genommen und es klappt wunderbar.
Das hätte ich nie allein hin bekommen.
Jetzt muss ich nur noch alle Sonderzeichen durchgehen, welche Windows in einem Ordnernamen nicht zulässt und diese aus den Straßennamen entfernen.
Existiert in den Straßennamen ein solches, in Windows-Ordnernamen nicht zulässiges Sonderzeichen, bricht das Makro (zu recht) ab.
Oder, ich traue mich fast gar nicht zu fragen, hast Du dafür etwa auch eine Lösung?
VG und nochmal DANKE!
Thomas
Anzeige
AW: Ordner und Unterordner per Makro anlegen
06.05.2021 13:35:22
Nepumuk
Hallo Thomas,
durch was sollen die "verbotenen Zeichen" ersetzt werden?
Gruß
Nepumuk
AW: Ordner und Unterordner per Makro anlegen
06.05.2021 13:47:20
Thomas
Ach man, dass ich immer wichtige Informationen vergesse - tut mir sehr leid.
Die "verbotenen Zeichen" können gern durch einen Bindestrich (also - ) ersetzt werden.
AW: Ordner und Unterordner per Makro anlegen
06.05.2021 13:53:51
Thomas
Ach man, dass ich immer wichtige Informationen vergesse - tut mir sehr leid.
Die "verbotenen Zeichen" können gern durch einen Bindestrich (also - ) ersetzt werden.
Anzeige
AW: Ordner und Unterordner per Makro anlegen
06.05.2021 14:04:05
Nepumuk
Hallo Thomas,
dann so:
Code:



[Cc][+][-]



Option Explicit

Private Declare PtrSafe Function MakeSureDirectoryPathExists Lib "imagehlp.dll" ( _
        ByVal DirPath As String) As Long


Public Sub CreateFolders()

  Dim avntFolders As Variant
  Dim ialngIndex As Long
  Dim strTown As String, strMainFolder As String, strRoad As String
  Dim lngReturn As Long

'    strMainFolder = Environ$("ONEDRIVE") & "&bsol;Desktop&bsol;Bauprojekte&bsol;"

  strMainFolder = Environ$("USERPROFILE") & "&bsol;Desktop&bsol;Bauprojekte&bsol;"

  avntFolders = Range(Cells(1, 1), Cells(Rows.Count, 2).End(xlUp)).Value2

  For ialngIndex = LBound(avntFolders, 1) To UBound(avntFolders, 1)

      If strTown <> avntFolders(ialngIndex, 1) Then

         strTown = avntFolders(ialngIndex, 1)

         lngReturn = MakeSureDirectoryPathExists(strMainFolder & strTown & "&bsol;")

         If lngReturn = 0 Then

            Call MsgBox("Fehler beim anlegen des Ordners " & strTown, vbCritical, "Programmabbruch")
            Exit Sub

         End If
      End If

      strRoad = KillForbiddenSigns(avntFolders(ialngIndex, 2))

      lngReturn = MakeSureDirectoryPathExists(strMainFolder & strTown & "&bsol;" & strRoad & "&bsol;")

      If lngReturn = 0 Then

         Call MsgBox("Fehler beim anlegen des Ordners " & avntFolders(ialngIndex, 2), vbCritical, "Programmabbruch") _
              
         Exit Sub

      End If
  Next
End Sub

Private Function KillForbiddenSigns(ByVal pvstrRoad As String) As String
  pvstrRoad = Replace$(pvstrRoad, "", "-")
  pvstrRoad = Replace$(pvstrRoad, "?", "-")
  pvstrRoad = Replace$(pvstrRoad, "*", "-")
  pvstrRoad = Replace$(pvstrRoad, "<", "-")
  pvstrRoad = Replace$(pvstrRoad, ">", "-")
  pvstrRoad = Replace$(pvstrRoad, ".", "-")
  pvstrRoad = Replace$(pvstrRoad, ",", "-")
  pvstrRoad = Replace$(pvstrRoad, "&bsol;", "-")
  pvstrRoad = Replace$(pvstrRoad, "+", "-")
  pvstrRoad = Replace$(pvstrRoad, ":", "-")
  pvstrRoad = Replace$(pvstrRoad, "=", "-")
  pvstrRoad = Replace$(pvstrRoad, "/", "-")
  pvstrRoad = Replace$(pvstrRoad, ";", "-")
  pvstrRoad = Replace$(pvstrRoad, "[", "-")
  pvstrRoad = Replace$(pvstrRoad, "]", "-")
  pvstrRoad = Replace$(pvstrRoad, "|", "-")
  pvstrRoad = Replace$(pvstrRoad, Chr$(34), "-")
  KillForbiddenSigns = pvstrRoad
End Function
Gruß
Nepumuk
Anzeige
AW: Ordner und Unterordner per Makro anlegen
06.05.2021 14:14:32
Thomas
Und nochmal: VIELEN HERZLICHEN DANK.
Funktioniert einwandfrei!!!!
VG
Thomas

Forumthreads zu verwandten Themen

Unterordner und Arbeitsmappe erstellen
Werner

Hallo,
ich bräuchte wieder mal einen Schubser weil ich keinen Plan habe wie man folgendes machen könnte:
Ich möchte in dem Ordner, in dem sich meine Datei befindet, einen Unterordner erstellen.
Meine Überlegungen dazu: Prüfen, ob der Unterordner existiert, wenn nicht, erstellen
...
24.01.2009 11:20:00
Thread-ID: 1043302
4 Beiträge
VBA - Verzeichnisse erstellen und manuell löschen
Christian

Hallo bestes Forum,
per vba möchte ich ein Haupt-Verzeichnis erstellen, falls dieses noch nicht existiert.
In diesem Ordner werden weitere Unterordner erstellt (auch wieder nur dann, wenn es diese noch nicht gibt).
Diese mit meinem Script (siehe unten) erstellten Verzeichnisse zeige...
09.09.2010 21:01:16
Thread-ID: 1176718
6 Beiträge
Ordner- und Unterordnerstrukturen anlegen
sruhsam

Hallo Profis
habe ein Problem beim automatischen erstellen von Verzeichnisse aus Excel heraus.
Ziel ist es durch die in Excel eingegebene Daten eine Ordnerstruktur zu erstellen. Dies soll in 3 Stufen gegliedert sein.
1. Stufe:
Einfaches erstellen von Verzeichnisse im Pfad (B1)....
25.01.2011 11:45:57
Thread-ID: 1197206
9 Beiträge
Am 1.1. per VBA Ordner 2014 anlegen
Bernd

Hallo zusammen,
Brauche Hilfe bei nachfolgendem Problem, komme einfach nicht weiter.
Und zwar möchte ich das automatisch beim ersten Öffnen der Arbeitsmappe im Ordner "D:\Firma\Schriftwechsel\" ein neuer Ordner mit der aktuellen Jahreszahl (2014) angelegt wird.
Wer kann mir behilfli...
17.09.2013 10:54:53
Thread-ID: 1331135
12 Beiträge
Anzeige
Makro erweitern - Ordner aus Blattname erstellen
Ulf

Moin, moin
ich möchte meine Vorlage noch verfeinern, weiß aber nicht wie.
Im Blatt "20µ-50µ" SpalteB wird eine Ser.Nr. vergeben. Es wird ein neues Blatt mit dieser Ser.Nr. erstellt. Soweit alles perfekt.
Jetzt möchte ich, wenn eine Ser.Nr. vergeben wird im Ordner: P:\Operations-Prod...
17.03.2015 10:05:08
Thread-ID: 1415404
4 Beiträge
Erstellen von Ordnern durch VBA
Ordnern

Hallo Community,
ich hätte eine Frage. Und zwar würde ich gerne per VBA einen Button in Excel erstellen, welches dann immer in jeder Exceldatei dieser Art verfügbar ist. Generell ist in den Exceldateien ein Datenblatt abgebildet.
Das Programm sollte zwei Arrays enthalten, die eine Anz...
04.04.2018 10:37:24
Thread-ID: 1617949
6 Beiträge
pdf erstellen und in einen Ordner ablegen
MichaelHartig

Hallo zusammen,
ich hab in den letzen Monat echt dazugelernt was VBA angeht aber ein Problem bekomme ich nicht gelöst. Vielleicht habt Ihr eine Idee:
Ich habe ein Makro erstellt, dass ein Workbook als pdf ablegen kann und auch ein Makro was _ einen Ordner mit dem richtigen Namen erzeug...
22.02.2019 09:44:04
Thread-ID: 1677125
4 Beiträge
Ordner mit Unterordner erstellen VBA
JimKnopf76

Hallo zusammen,
zurzeit möchte ich mit Hilfe des folgenden Codes, welche ich hier im Archiv gefunden habe, Ordner und Unterordner erzeugen. Allerdings wird lediglich mit dem Zelle B1 Werten ein Ordner erzeugt. Wie sieht eine Schleife, sodass die Werte in Pfad = Range("B1") hochgezählt werde...
18.07.2019 13:39:19
Thread-ID: 1703107
6 Beiträge
pdf sortieren und Ordner erstellen via VBA Teil 2
Tom

Hallo zusammen,
leider kann ich nicht mehr auf meinen alten Beitrag antworten, daher erstelle ich jetzt einen neuen.
Franz (oder auch fcs), erstmal vielen Dank fuer deine Hilfe. Ich hoffe mein Dank erreicht dich auf irgendeine Weise.
Franz hat mir folgenden Code geschrieben:
---...
30.07.2019 01:53:13
Thread-ID: 1704877
2 Beiträge
pdf sortieren und Ordner erstellen via VBA Teil 3
Tom

Hallo zusammen,
Ich habe einen Code mithilfe des Forums (grosses Dankeschoen an Franz bzw. fcs) erarbeitet und verwende ihn seit einigen Wochen.
Mittlerweile sind mir einige Probleme aufgefallen, die ich nicht geloest bekomme.
Ich sortiere mithilfe des Makros mehrere pdf Dateien und...
29.08.2019 05:16:04
Thread-ID: 1710143
2 Beiträge
Anzeige
Änderungsdatum in Ordner und Unterordner
Russi
Hallo Forum,
kurze Frage. Was muss ich in untenstehendes Makro noch einbauen, damit ich neben den Angaben der gefundenen Dateien das Änderungsdatum ("Geändert am") und den Dateityp separat ("Typ") gemäß Explorer anzeigen lassen möchte? Habe leider keinen Ansatz.
Für eure Hilfe besten Dank
08.03.2004 14:16:57
Thread-ID: 394018
2 Beiträge
Ordner und Unterordner alphabet öffnen
Thomas
Hi zusammen,
wie kann man denn die Daten aus einem Ordner mit mehreren Unterordnern auslesen und nach Ordnern sortiert ausgeben????

Ich hab es bis jetzt immer so gemacht:
With Application.FileSearch
'Öffnen d. Dateien
.LookIn = pfadm
.SearchSubFolders...
16.03.2004 16:01:43
Thread-ID: 398783
4 Beiträge
Anzeige

Beliebteste Forumthreads (12 Monate)

Jetzt das Excel-Portal bewerten: Deine Stimme zählt!
Anzeige
Anzeige
Anzeige