Ordner erstellen und Verknüpfen

Forumthread: Ordner erstellen und Verknüpfen

06.06.2019 15:35:57

Steve

Moin,
Ich möchte gerne per VBA aus einer Liste Ordner erstellen und diese dann direkt mit dem entsprechenden Listeneinträgen per Hyperlink verbinden.
Derzeit habe ich eine Lösung aber die ist wenig flexibel. Wenn ich nun die Liste vergrößere muss ich den VBA Code entsprechend anpassen.
Kann mir hier jemand Bitte helfen?
Liebe Grüße
Steve

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Ordner erstellen und Verknüpfen

06.06.2019 15:39:56

Torsten
AW: Ordner erstellen und Verknüpfen

06.06.2019 16:04:57

Steve
AW: Ordner erstellen und Verknüpfen

11.06.2019 23:27:28

Piet

AW: Ordner erstellen und Verknüpfen

06.06.2019 15:39:56

Torsten

Hallo Steve,
da kann sicher geholfen werden, wenn du deinen Code oder noch besser eine Beispieldatei vorzeigst.
Gruss

AW: Ordner erstellen und Verknüpfen

06.06.2019 16:04:57

Steve

Moin Torsten,
das mache ich gerne. Ich sende mal den betreffenden Teil des Gesamtcodes. Hoffe das reicht aus.
'''''''''''''''''''''''''
'ORDNER FÜR NEUE TABELLE'
'''''''''''''''''''''''''
Dim filesystem As Object
Dim strPfad As String
strPfad = ThisWorkbook.Path
Set filesystem = CreateObject("Scripting.FileSystemObject")
filesystem.CopyFolder strPfad & "\001 Aktive Mitarbeiter\000 MASTER", strPfad & "\001 Aktive Mitarbeiter\" & Blatt
Set filesystem = Nothing
'''''''''''''''''''''''''''''
'HYPERLINKS FÜR NEUE TABELLE'
'''''''''''''''''''''''''''''
Range("L5").Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
"001 Aktive Mitarbeiter\" & Blatt & "\" & "001%20Arbeitsanweisungen", _
TextToDisplay:="Arbeitsanweisungen"
Range("L6").Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
"001 Aktive Mitarbeiter\" & Blatt & "\" & "002%20Krank", _
TextToDisplay:="Krank"
Range("L7").Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
"001 Aktive Mitarbeiter\" & Blatt & "\" & "003%20Urlaub", _
TextToDisplay:="Urlaub"
Range("L8").Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
"001 Aktive Mitarbeiter\" & Blatt & "\" & "004%20Kleidung_Werkzeug", _
TextToDisplay:="Kleidung / Werkzeug"
Range("L9").Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
"001 Aktive Mitarbeiter\" & Blatt & "\" & "005%20sonstiges", _
TextToDisplay:="SONSTIGES"
Range("A2").Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
"001 Aktive Mitarbeiter\" & Blatt, _
TextToDisplay:=Blatt
das ist der bisherige Code. Wie man sieht greift er jeden einzelnen Listeneintrag separat ab. Den Hauptordner bezieht er aus dem Tabellenblattnamen. (Blatt)
Die Unterordner werden erstellt und verknüpft aber total statisch.
Ich dachte mir, ich könnte es irgendwie schaffen das der Code die Liste ausliest und dann anhand der Einträge die Unterordner erstellt.
Spontan würde ich sagen ich brauche eine Schleife die die Tabelle (dachte da an eine dynamische Tabelle, dann würde der Tabellenname reichen) ausliest und dann für jeden Eintrag einen Ordner erstellt und diesen Verknüpft. Aber irgendwie reichen meine Kenntnise dafür nicht aus.
Liege ich da richtig?
Fürs Protokoll: Ich muss nicht unbedingt eine Lösung erhalten. Wenn ich einen gut zu verstehenden Tipp erhalten kann bin ich schon dankbar.
Liebe Grüße
Steve

AW: Ordner erstellen und Verknüpfen

11.06.2019 23:27:28

Piet

Hallo Steve
ich gib dir einen Tipp wie ich das in für Praxis machen würde. Über eine For Next Schleife! -Ohne- Select!!
LastZell = Cells(Rows.Count, 12).End(xlUp).Row
For i = 5 to LastZell - die LastZell musst du festlegen oder vorher wie oben ermitteln!
Lege dir ab "L5" eine Datenbank an, indem du Spalte M + N als Text Spalten mit verwendest. In M den Text für den Hyperlink, in N den Display Text. Dann kannst du mit HypTxt = Cells(i, 12) und DispTxt = Cells(,, 13) diesen Text in Variable laden und den Hyperlink per Variable anlegen. Der fertige Code könnte so wie unten aussehen - NICHT getestet!!
mfg Piet

Sub Hyperlinks_erstellen()
Dim i As Long, LastZell As Long, MTA
Dim HypTxt As String, DispTxt As String
'LastZell in Spalte L ermitteln
LastZell = Cells(Rows.Count, 12).End(xlUp).Row
'Schleife für beliebige Hyperlink erstellen
For i = 5 To LaztZell
HypTxt = Cells(i, 13).Value
DispTxt = Cells(i, 14).Value
MTA = "001 Aktive Mitarbeiter\"  'gleichbleibender Text
ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 12), Address:= _
MTA & Blatt & "\" & "001%20" & HypTxt, TextToDisplay:=DispTxt
Next i
End Sub

Beliebteste Forumthreads (12 Monate)

Forumthread: Ordner erstellen und Verknüpfen

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread