Ordner anlegen

[snb]

Verzichte auf Ordnern und Unterordnern.
Speichere die Dateien in 1 Ordner und gebe die Dateien ID-orientierte Namen.
Denke bitte mal nicht mehr in 'Papier'.

[Case]

Hallo,

wie soll z. B. mit "1.1.03 Baugesuch / Pläne" und weiteren verfahren werden? Ordner mit Sonderzeichen kannst du nicht anlegen.

[Warkings]

Folgender Code tut das, was angfordert wurde, wobe ich die Tabelle Revi umgestaltet habe

Option Explicit
Private Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" ( _
  ByVal lpPath As String) As Long

Property Get GEWERKE() As String
' Root Dir for "Gewerke"
    GEWERKE = "D:\GEWERKE"
End Property

Property Get REVI() As String
' Root Dir for "Revi"
    REVI = "D:\REVI"
End Property
 
Sub mkDirs(rootDir As String, vDat As Variant)
       
    Dim sngElement As Variant
    Dim dirName As String
   
    For Each sngElement In vDat
        dirName = VBA.Trim(sngElement)
        ' no feedback if folder name is really valid or on success requested
        MakeSureDirectoryPathExists rootDir & Application.PathSeparator & dirName & Application.PathSeparator
    Next sngElement
   
End Sub

Sub mkGewerke()
   
    Dim rg As Range
    Set rg = Tabelle1.Range("A1").CurrentRegion.Columns(1)
   
    Dim vDat As Variant
    vDat = WorksheetFunction.Transpose(rg)
   
    mkDirs GEWERKE, vDat
   

End Sub

Sub mkRevi()
   
    Dim rg As Range
    Dim vDat As Variant
    Dim rDat As Variant
   
    Set rg = Union(Tabelle2.Range("A2").CurrentRegion.Columns(1), Tabelle2.Range("A2").CurrentRegion.Columns(2))
   
    vDat = rg
    ReDim rDat(1 To UBound(vDat))
   
    Dim i As Long, j As Long: j = 1
    For i = LBound(vDat) To UBound(vDat)
        rDat(j) = vDat(i, 1) & "\" & vDat(i, 2)
        j = j + 1
    Next i
   
    mkDirs REVI, rDat

End Sub

@Case: siehe meinen Code, keine Anforderung dazu, also passiert NICHTS

[wavemaster]

Hallo Warkins,
einfach sagenhaft
vielen vielen Dank

---

Hallo Case,
es geht siehe unten
Trotzdem Danke

[wavemaster]

Hallo Warkins,
hätte noch eine Frage zu dem Code.
erstens er funktioniert Tadelos  

was muß geändert werden wenn ich in der Arbeitsmappe Gewerke mehr Spalten ( zb. A-Z) benötige,
das gleiche gilt für die Arbeitsmappe REVI.

Danke vorab

[wavemaster]

Hallo Warkins,
hätte noch eine Frage zu dem Code.
erstens er funktioniert Tadelos  

was muß geändert werden wenn ich in der Arbeitsmappe Gewerke mehr Spalten ( zb. A-Z) benötige,
das gleiche gilt für die Arbeitsmappe REVI.

Danke vorab

Hat vielleicht jemand eine Idee dies umzusetzen.

Habe jetzt ein paar versuche gestartet klappt einfach nicht.....

[schauan]

Hallöchen,

A:Z:

Code:

Sub test()
MsgBox Tabelle1.Range("A1").CurrentRegion.Columns(1).Resize(, 26).Address
End Sub

[snb]

Scheint mir genug:

Code:

Sub test()
   MsgBox Tabelle1.Range("A1").CurrentRegion.Resize(, 26).Address
End Sub

[wavemaster]

Hallo Schauen,
Danke vorab.
Wo muss ich das Einfügen bzw muss ich eine Zeile löschen.

[schauan]

Hallöchen,

es geht ja um einen Bereich.

Dim rg As Range

oder zu deutsch

Dim rg Als Bereich

Also schaust Du, wo rg gebildet wird. Das passiert z.B. da:

Set rg = Tabelle1.Range("A1").CurrentRegion.Columns(1)

(oder anders formuliert: Setze den Bereich auf Tabelle1...)


Das ersetzt Du durch

Set rg = Tabelle1.Range("A1").CurrentRegion.Resize(, 26)