Ordner erstellen

Forumthread: Ordner erstellen

Ordner erstellen

25.01.2025 16:14:52

Max

Hallo zusammen
ich habe eine Excel tabelle angelegt.
Jetzt möchte ich für jeden neue Eintrag ein Ordner im C Laufwerk anlegen, des weiteren soll ein Link estellt werden sodass ich per Mausklick direkt im Ordner gelange.

z.B. Zelle
B2 Name = Test
der Ordner soll Test heißen und in der Spalte H2 soll der Link zum Laufwerk sein bzw. dazugehörige Ordner
B3 Name = Test2
der Ordner soll Test2 heißen und in der Spalte H3 soll der Link zum Laufwerk sein bzw. dazugehörige Ordner

usw..

Wer kann mir helfen

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Ordner erstellen

25.01.2025 16:36:21

Max
Das könntest du...

25.01.2025 17:13:09

Case
AW: Das könntest du...

25.01.2025 22:56:07

Max
Dann ändere diese...

26.01.2025 00:05:06

Case
AW: Dann ändere diese...

30.01.2025 20:24:14

Max
Das geht dann...

30.01.2025 20:47:29

Case
Und die...

30.01.2025 20:55:25

Case
AW: Und die...

12.02.2025 15:08:18

Max

AW: Ordner erstellen

25.01.2025 16:36:21

Max

PS : diesen Code habe ich bereits angelegt und funktioniert ohne Probleme
Es fehlt mir nur noch die Verbindung bzw. direkte Link

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range, Pfad As String, UOrd As String
Set Rng = Range("A3:A11") 'Auslösende Zelle
Pfad = "C:\Users\muster\Desktop\Neuer Ordner\Dokumente\" 'mit \ am Ende
If Not Intersect(Rng, Target) Is Nothing Then
If Dir(Pfad & Target, vbDirectory) = "" Then
MkDir Pfad & Target
Else
MsgBox Pfad & Target & " ist schon vorhanden"
End If
End If
End Sub

Das könntest du...

25.01.2025 17:13:09

Case

Moin, :-)

... z. B. so lösen: ;-)

Option Explicit

Private Declare PtrSafe Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal Pfad As String) As Long

Const strPath As String = "C:\Temp\" ' Anpassen - MIT Backslash am Ende

Private Sub Worksheet_Change(ByVal Target As Range)

    On Error GoTo Fin

    If Not Intersect(Target, Range("B2:B20")) Is Nothing Then

        Application.EnableEvents = False

        MakeSureDirectoryPathExists strPath & Target.Text & "\"

        Hyperlinks.Add Anchor:=Cells(Target.Row, 8), Address:=strPath & Target.Text & "\", TextToDisplay:=Target.Text

    End If

Fin:

    Application.EnableEvents = True

End Sub

Du musst im Code noch den Pfad anpassen. Im Moment läuft der Code, wenn du Eingaben in B2:B20 machst. Also bei Bedarf anpassen.

Servus
Case

AW: Das könntest du...

25.01.2025 22:56:07

Max

Hallo Case

danke für den Code
Das funktioniert ohne gut.
Wäre eventuell auch möglich die Verlinkung bzw. Hyperlink direkt in die erste Zelle zu hinterlegen..
Wenn ich in der Spalte B was eingebe, dann soll der Order und Hyperlink erstellt werden,

z.B. Zelle B2 gebe ich Max ein, dann soll der Order angelegt werden und im B2 soll dann der Hyperlink zum Ordner sein
wenn in B3 Jürgen eingebe, dann soll der Order angelegt werden und im B3 soll dann der Hyperlink zum Ordner sein
usw...

Dann ändere diese...

26.01.2025 00:05:06

Case

Moin, :-)

... Codezeile: ;-)

Hyperlinks.Add Anchor:=Cells(Target.Row, 8), Address:=strPath & Target.Text & "\", TextToDisplay:=Target.Text

Und schreibe es so: ;-)

Hyperlinks.Add Anchor:=Cells(Target.Row, Target.Column), Address:=strPath & Target.Text & "\", TextToDisplay:=Target.Text

Servus
Case

AW: Dann ändere diese...

30.01.2025 20:24:14

Max

Hallo Case

wäre auch möglich das zu jeden Ordner 3 Unterordner automatisch erstellt werden

Ordner Name = Spalte H und die Unterordner sollen "Offen" / "Erledigt" / "Warteliste" heißen

Danke im Voraus für deine Hilfe

Das geht dann...

30.01.2025 20:47:29

Case

Moin, :-)

... so: ;-)

Option Explicit

Private Declare PtrSafe Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal Pfad As String) As Long

Const strPath As String = "C:\Temp\" ' Anpassen - MIT Backslash am Ende

Private Sub Worksheet_Change(ByVal Target As Range)

    On Error GoTo Fin

    If Not Intersect(Target, Range("B2:B20")) Is Nothing Then

        Application.EnableEvents = False

        MakeSureDirectoryPathExists strPath & Target.Text & "\"

        MakeSureDirectoryPathExists strPath & Target.Text & "\Offen\"

        MakeSureDirectoryPathExists strPath & Target.Text & "\Erledigt\"

        MakeSureDirectoryPathExists strPath & Target.Text & "\Warteliste\"

        Hyperlinks.Add Anchor:=Cells(Target.Row, 8), Address:=strPath & Target.Text & "\", TextToDisplay:=Target.Text

    End If

Fin:

    Application.EnableEvents = True

End Sub

Servus
Case

Und die...

30.01.2025 20:55:25

Case

Moin, :-)

... 8 durch Target.Column ersetzen! ;-)

Servus
Case

AW: Und die...

12.02.2025 15:08:18

Max

Hallo zusammen,

die Ordner sind im Share Point gespeichert.
Wenn die Kollegen auf das Link klicken kann es nicht geöffnet werden, da sie mir einem anderen benutzer name arbeiten.
Wie kann ich das lösen ?

Forumthread: Ordner erstellen

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread