Excel und VBA: Formeln, Programmierung, Lösungen

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

    

Beiträge aus dem Excel-Forum zu den Themen Datei und Verzeichnis