Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1592to1596
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

Unterverzeichnisse nach Exceltabelle erstellen

Unterverzeichnisse nach Exceltabelle erstellen
03.12.2017 11:50:59
obelix
Hallo zusammen,
in Excel habe ich eine Verzeichnisstruktur erstellt. Diese Struktur möchte ich gerne mit Hilfe eines Makros auf dem gewünschten Pfad erstellen.
Insgesamt habe ich bis zu 7 Verzeichnisebenen die erstellt werden sollen.
Ein Beispiel habe ich als File Upload erstellt. Dieses kann hier eingesehen werden:
https://www.herber.de/bbs/user/118069.xlsx
Sicher kann mir hier geholfen werden, da doch einige Beispiele für das Einlesen von Verzeichnissen hier behandelt wurden. Der umgekehrte Weg sollte doch dann auch möglich sein?
Vielen Dank für Eure Unterstützung.
obelix

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Unterverzeichnisse nach Exceltabelle erstellen
03.12.2017 12:21:50
RPP63
Moin!
Wenn Du koplette Pfade i einer Spalte hast
c:\Hauptverzeichnis\3. Unterverzeichnis\3. UV 1…\3. UV 1…1\3. UV 1…1...1
dann reicht folgende API, die Du per Schleife abarbeiten kannst (hier als Beispiel):
Option Explicit
Declare Function MakePath& Lib "imagehlp.dll" Alias _
       "MakeSureDirectoryPathExists" (ByVal sPath$)

Sub CreatePath_()
Dim strPath As String
strPath = Environ("UserProfile") & "\Desktop\Test\1\2\"
MakePath strPath
End Sub
Gruß Ralf
Anzeige
AW: Unterverzeichnisse nach Exceltabelle erstellen
03.12.2017 13:33:51
obelix
Hallo Ralf,
leider verstehe ich Deine Lösung nicht - KEINE VBA-Kenntnisse -.
Du schreibst: "Wenn Du komplette Pfade in einer Spalte hast". Genau das habe ich nicht, sondern wie in der Beipieldatei sind die anzulegenden Verzeichnisse / Unterverzeichnisse in mehreren Spalten vorhanden.
Wo soll ich denn Deine Lösung einarbeiten? In ein Modul?
LG
obelix
keine VBA-Kenntnisse
03.12.2017 16:23:05
RPP63
Bei allem Respekt:
Du hast keine VBA-Kenntnisse und willst Excel für Dich (Unter-)Verzeichnisse erstellen lassen?
Dafür gibt dann eigentlich sowas wie Total Commander, den man (glaube ich) über Batch ansteuern kann.
Wenn Du die kompletten Pfade noch nicht in der Tabelle hast, solltest sie schlicht erstellen.
Dann eine Schleife über alle gefüllten Zellen der Spalte.
Pseudo-Code:
Dim Zelle As Range
For Each Zelle In Range("A5:A15")
MakePath Zelle.Text
Next

Gruß Asterix ;)
Anzeige
AW: Unterverzeichnisse nach Exceltabelle erstellen
04.12.2017 09:30:48
Nepumuk
Hallo Obelix,
Teste mal:
Option Explicit
Private Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" ( _
ByVal lpPath As String) As Long
Private Declare Function FormatMessageA Lib "kernel32.dll" ( _
ByVal dwFlags As Long, _
ByRef lpSource As Any, _
ByVal dwMessageId As Long, _
ByVal dwLanguageId As Long, _
ByVal lpBuffer As String, _
ByVal nSize As Long, _
ByRef Arguments As Long) As Long
Private Const FORMAT_MESSAGE_FROM_SYSTEM As Long = &H1000
Private Const LANG_NEUTRAL As Long = &H0
Public Sub Ordner_anlegen()
Dim lngColumn As Long, lngLastRow As Long
Dim ialngRow As Long, ialngColumn As Long
Dim lngReturn As Long
Dim strBuffer As String
Dim avntValues As Variant
Dim astrFolder(1 To 7) As String
Dim blnFound As Boolean
For lngColumn = 1 To 7
lngLastRow = WorksheetFunction.Max(lngLastRow, _
Cells(Rows.Count, lngColumn).End(xlUp).Row)
Next
avntValues = Range(Cells(7, 1), Cells(lngLastRow, 7)).Value2
For ialngRow = 1 To UBound(avntValues, 1)
blnFound = False
For ialngColumn = UBound(avntValues, 2) To 1 Step -1
If IsEmpty(avntValues(ialngRow, ialngColumn)) Then
If Not blnFound Then astrFolder(ialngColumn) = vbNullString
Else
astrFolder(ialngColumn) = avntValues(ialngRow, ialngColumn) & "\"
blnFound = True
End If
Next
lngReturn = MakeSureDirectoryPathExists(Join(astrFolder, vbNullString))
If lngReturn = 0 Then
strBuffer = Space$(200)
Call FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM, ByVal 0&, _
Err.LastDllError, LANG_NEUTRAL, strBuffer, 200, ByVal 0&)
strBuffer = Left$(strBuffer, InStrRev(strBuffer, vbNullChar) - 1)
Call MsgBox(strBuffer, vbCritical, "Fehlermeldung")
Exit Sub
End If
Next
Call MsgBox("Erledigt", vbInformation, "Information")
End Sub

Gruß
Nepumuk
Anzeige
AW: Unterverzeichnisse nach Exceltabelle erstellen
04.12.2017 19:53:28
obelix
Hallo Nepumuk,
genau diese Lösung habe ich gesucht.
Vielen lieben Dank für Deine Unterstützung.
LG obelix
AW: Unterverzeichnisse nach Exceltabelle erstellen
04.12.2017 19:55:38
obelix
Hallo Bernd,
vielen Dank auch für Deine Lösung. Wann hat man schon zwei alternative Lösungen, Deine und die von Nepumuk zur Verfügung.
Beide Lösungen kann ich verwenden und komme so an die Lösung für die Aufgabenstellung.
LG obelix
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige