Tobias B
asked on
vba code to create folders according to a hyperlink
hello together,
how could i upgrade my existing code witch creates an hyperlink in column B that the code check if the folder is already existing and if not the code will create the folder?
this is the relevant part of my coder to create the hyperlink:
could someone help me to upgrade the code to create the folders automatically?
thanks in advance.
Tobias
how could i upgrade my existing code witch creates an hyperlink in column B that the code check if the folder is already existing and if not the code will create the folder?
this is the relevant part of my coder to create the hyperlink:
Pfad = "\\C:\Temp\Test\"
.....
If Sh.Cells(Target.Row, "A") <> "" And Sh.Cells(Target.Row, "D") <> "" And Sh.Cells(Target.Row, "G") <> "" Then
Sh.Cells(Target.Row, "B") = Sh.Cells(Target.Row, "A")
Sh.Hyperlinks.Add _
Anchor:=Sh.Cells(Target.Row, "B"), _
Address:=Pfad & _
Format(Year(Sh.Cells(Target.Row, "G")), "0000") & "_" & _
Format(Month(Sh.Cells(Target.Row, "G")), "00") & "_" & _
Format(Day(Sh.Cells(Target.Row, "G")), "00") & "\" & _
Sh.Cells(Target.Row, "D") & "\" & _
Sh.Cells(Target.Row, "A")
Else
Sh.Cells(Target.Row, "B") = ""
End If
Application.EnableEvents = True
End Sub
could someone help me to upgrade the code to create the folders automatically?
thanks in advance.
Tobias
ASKER
Hello Rgonzo1971,
thank you for your answer. honestly i didn´t know if i have understand it correctly.
i have taken this:
but this will not create the Folder. just the Hyperlink is created and nothing else happened.
there was a failure that Vollpfad is not defined and i defined it like this: Dim VollPfad As String
I’m not sure what to do with this:
thanks
thank you for your answer. honestly i didn´t know if i have understand it correctly.
i have taken this:
Pfad = "\\C:\Temp\Test\"
If sh.Cells(Target.Row, "A") <> "" And sh.Cells(Target.Row, "D") <> "" And sh.Cells(Target.Row, "G") <> "" Then
sh.Cells(Target.Row, "B") = sh.Cells(Target.Row, "A")
VollPfad = Pfad & _
Format(sh.Cells(Target.Row, "G"), "yyyy-mm-dd") & "\" & _
sh.Cells(Target.Row, "D") & "\"
If Len(Dir(VollPfad, vbDirectory)) = 0 Then
Shell ("cmd /c mkdir -p """ & VollPfad & """")
End If
sh.Hyperlinks.Add _
Anchor:=sh.Cells(Target.Row, "B"), _
Address:=VollPfad & _
sh.Cells(Target.Row, "A")
Else
sh.Cells(Target.Row, "B") = ""
End If
but this will not create the Folder. just the Hyperlink is created and nothing else happened.
there was a failure that Vollpfad is not defined and i defined it like this: Dim VollPfad As String
I’m not sure what to do with this:
1:YourPath = "c:\tmp\EE\Examples"
2:If Len(Dir(YourPath, vbDirectory)) = 0 Then
3: Shell ("cmd /c mkdir -p """ & YourPath & """")
4:End If
thanks
Is VollPfad the path of the hyperlink?
line 6 to 11 create the VollPfad folder(s) if necessary normally
line 6 to 11 create the VollPfad folder(s) if necessary normally
ASKER
?? VollPfad was a Change from your side ;-)
in my code is Address
in my code is Address
You have
Pfad = "\\C:\Temp\Test\"
then
VollPfad = Pfad & _
Format(sh.Cells(Target.Row , "G"), "yyyy_mm_dd") & "\" & _
sh.Cells(Target.Row, "D") & "\"
that represents the folder to be created is that right?
Pfad = "\\C:\Temp\Test\"
then
VollPfad = Pfad & _
Format(sh.Cells(Target.Row
sh.Cells(Target.Row, "D") & "\"
that represents the folder to be created is that right?
Pfad = "\\C:\Temp\Test\"
If sh.Cells(Target.Row, "A") <> "" And sh.Cells(Target.Row, "D") <> "" And sh.Cells(Target.Row, "G") <> "" Then
sh.Cells(Target.Row, "B") = sh.Cells(Target.Row, "A")
VollPfad = Pfad & _
Format(sh.Cells(Target.Row, "G"), "yyyy_mm_dd") & "\" & _
sh.Cells(Target.Row, "D") & "\"
If Len(Dir(VollPfad, vbDirectory)) = 0 Then
Shell ("cmd /c mkdir -p """ & VollPfad & """")
End If
sh.Hyperlinks.Add _
Anchor:=sh.Cells(Target.Row, "B"), _
Address:=VollPfad & _
sh.Cells(Target.Row, "A")
Else
sh.Cells(Target.Row, "B") = ""
End If
Corrected code: underscore in date instead of minus
ASKER
ok, it Looks like we have some other Problems.
attached you will find the complete code. maybe you got upgrade this code.
i thought i was able to add the changes in my code but obviously I’m doing something wrong.
This code will also create a Protocol of all changes in my list and creates the Hyperlink.
from line 33 it starts with the hyperlink
attached you will find the complete code. maybe you got upgrade this code.
i thought i was able to add the changes in my code but obviously I’m doing something wrong.
This code will also create a Protocol of all changes in my list and creates the Hyperlink.
from line 33 it starts with the hyperlink
Option Explicit
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim lngZeile As Long
Dim NeuerWert As Variant
Dim AlterWert As Variant
Dim Pfad As String
Pfad = "\\1000\Vert\Team 1\Au\Test\"
If Sh.Name = "Protokoll" Then Exit Sub
Application.EnableEvents = False
NeuerWert = Target.Value ' Neuen Wert merken
Application.Undo ' Änderung rückgängig
AlterWert = Target.Value ' Alten Wert merken
Target.Value = NeuerWert ' Änderung wieder herstellen
With Worksheets("Protokoll")
.Unprotect
lngZeile = .Range("A65536").End(xlUp).Row + 1
.Cells(lngZeile, 1).Value = Application.UserName 'Benutzer
.Cells(lngZeile, 2).Value = Date 'Datum
.Cells(lngZeile, 3).Value = Time 'Zeit
.Cells(lngZeile, 4).Value = Sh.Name 'Blattname, auf dem geändert wurde
.Cells(lngZeile, 5).Value = Target.Address(0, 0) 'Zelle der Änderung
.Cells(lngZeile, 6).Value = AlterWert 'alter Eintrag
.Cells(lngZeile, 7).Value = Target.Value 'neuer Eintrag
.Cells(lngZeile, 8).Value = Sh.Cells(Target.Row, "A") 'Spalte "A"
.Protect
End With
If Sh.Cells(Target.Row, "A") <> "" And Sh.Cells(Target.Row, "D") <> "" And Sh.Cells(Target.Row, "G") <> "" Then
Sh.Cells(Target.Row, "B") = Sh.Cells(Target.Row, "A")
Sh.Hyperlinks.Add _
Anchor:=Sh.Cells(Target.Row, "B"), _
Address:=Pfad & _
Format(Year(Sh.Cells(Target.Row, "G")), "0000") & "_" & _
Format(Month(Sh.Cells(Target.Row, "G")), "00") & "_" & _
Format(Day(Sh.Cells(Target.Row, "G")), "00") & "\" & _
Sh.Cells(Target.Row, "D") & "\" & _
Sh.Cells(Target.Row, "A")
Else
Sh.Cells(Target.Row, "B") = ""
End If
Application.EnableEvents = True
End Sub
what is it in Sh.Cells(Target.Row, "A")?
ASKER
in column "A" is the Name for the "target" Folder
the code creates a Hyperlink with the Information from column G,D and A in the column B
G and D are subfolders
the code creates a Hyperlink with the Information from column G,D and A in the column B
G and D are subfolders
ASKER
G is a date, but the Folder should have another date Format. thats the reaseon for the "complex" code for column G
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
works perfect!! thank you very much for your support.
where was the failure?
where was the failure?
I thought the last cell was a file not a folder
ASKER
so once again thank you for your Support and have a nice Weekend.
ASKER
Problem was solved. Many thanks to Rgonzo1971
pls try
Open in new window
maybe like thisOpen in new window
EDIT added CodeRegards