Gruppe
Datei
Bereich
Verzeichnis
Thema
Verzeichnisse gemäß Tabelleneintragen anlegen
Problem
Es sollen Verzeichnisse gemäß den Eintragungen in der Tabelle angelegt werden.
Lösung
Den nachstehenden Code in ein Standardmodul eingeben, einer Schaltfläche zuweisen und starten.
StandardModule: Modul1
Sub SetDir()
Dim iRow As Integer, iCol As Integer
Dim sDir As String, sVerz As String
iRow = 1
Do Until IsEmpty(Cells(iRow, 1))
iCol = 1
Do Until IsEmpty(Cells(iRow, iCol))
sVerz = Cells(iRow, iCol).Value
sVerz = WorksheetFunction.Substitute(sVerz, "\", "")
sDir = sDir & "\" & sVerz
If Left(sDir, 1) = "\" Then sDir = Right(sDir, Len(sDir) - 1)
On Error Resume Next
If iCol > 1 Then MkDir sDir
On Error GoTo 0
iCol = iCol + 1
Loop
sDir = ""
iRow = iRow + 1
Loop
On Error GoTo 0
End Sub