Ordner aus Pfad + Unterordner...

Hallo liebes Excel-Forum,
ich versuche mich gerade an einem VBA, das interaktiv agieren soll und komme leider nicht mehr weiter und hoffe nun auf eure Hilfe.
Die Datei (Testdatei) erstellt automatisch in Spalte H eine Verlinkung zu einem definierten Ordnerpfad, wenn die Zellen davor befüllt wurden.
Als Grunddatei soll diese Datei leer sein und wird für ein jeweiliges Jahr/Anliegen in einem anderen Ordnerpfad kopiert und dann befüllt.
Um nicht jedes Mal diesen fest hinterlegten Link änderen zu müssen (Ablage von Dokumenten im gleichen Ordnerpfad wie die Datei) habe ich mir überlegt, ob es nicht möglich ist, diesen Hauptpfad Interaktiv zu gestalten mit vorheriger Prüfung, ob der Unterordner "Dokumente" in dem Pfad angelegt ist oder eben nicht und diesen dann noch zusätzlich erstellen.
Der Grundaufbau der Datei nachfolgend mit automatischer Ordnererstellung zu einem fest definierten Pfad.
https://www.herber.de/bbs/user/146541.xlsm
Soll-Vorstellung:
Die Datei wird zum Beispiel in den Pfad C:Test\2021 verschoben
- daraus ergibt sich der neue Pfad C:Test\2021\Dokumente\Unterordnersname aus Spalte 1+3
Die Datei wird zum Beispiel in den Pfad C:Erweiterung\Test verschoben
- daraus ergibt sich der neue Pfad C:Erweiterung\Test\Dokumente\Unterordnername aus Spalte 1+3
Ich danke euch schonmal vorab für eure Hilfe und Unterstützung.
Gruß Crosser_gerone

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub Worksheet_Change(ByVal Target As Range) Dim lstrPath As String If Not Intersect(Target, Range("B6:G13")) Is Nothing Then If Range("B" & Target.Row).Value "" Or _ Range("D" & Target.Row).Value "" Or _ Range("F" & Target.Row).Value "" Or _ Range("G" & Target.Row).Value "" Then Application.EnableEvents = False Range("H" & Target.Row) = "" lstrPath = ThisWorkbook.Path & Application.PathSeparator _ & Range("B" & Target.Row).Value _ & Range("F" & Target.Row).Value _ & Format(Now, "YYYYhhmmss") If Dir(lstrPath, vbDirectory) = "" Then MkDir lstrPath ActiveSheet.Hyperlinks.Add Anchor:=Range("H" & Target.Row), Address:=lstrPath, TextToDisplay:=Right(lstrPath, 10) Application.EnableEvents = True End If End If End Sub

Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) Dim lstrPath As String If Not Intersect(Target, Range("B6:G13")) Is Nothing Then If Range("B" & Target.Row).Value "" Or _ Range("D" & Target.Row).Value "" Or _ Range("F" & Target.Row).Value "" Or _ Range("G" & Target.Row).Value "" Then Application.EnableEvents = False Range("H" & Target.Row) = "" lstrPath = ThisWorkbook.Path & Application.PathSeparator & "Dokumente" & Application.PathSeparator If Dir(lstrPath, vbDirectory) = "" Then _ MkDir ThisWorkbook.Path & Application.PathSeparator & "Dokumente" & Application.PathSeparator lstrPath = lstrPath _ & Range("B" & Target.Row).Value _ & Range("F" & Target.Row).Value _ & Format(Now, "YYYYhhmmss") If Dir(lstrPath, vbDirectory) = "" Then MkDir lstrPath ActiveSheet.Hyperlinks.Add Anchor:=Range("H" & Target.Row), Address:=lstrPath, TextToDisplay:=Right(lstrPath, 10) Application.EnableEvents = True End If End If End Sub

Beliebteste Forumthreads (12 Monate)

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread