AW: Hyperlink in freigegebenen Dateien
13.03.2023 09:03:23
ChrisL
Hi
https://www.herber.de/forum/archiv/1920to1924/1923508_Zelleninhalt_mit_automatischer_Verknuepf.html
Letztes mal habe ich angenommen, dass es sich ausser der Projektnummer um Konstante handelt. Nun verstehe ich, dass die Ordnernamen unbekannt sind und eine Dateisuche gestartet werden muss.
Nachfolgend mein Chat-Verlauf mit der KI. Damit möchte ich aufzeigen, wie man die Frage immer wieder spezifizieren kann. Ich musste 2x nachhaken, bis eine m.E. zielführende Lösung entstanden ist. Per Klick auf die Zelle wird eine Dateisuche gestartet. Die Suche dauert zwangsläufig etwas länger.
cu
Chris
excel vba. klick auf spalte a. wenn leer, dann verlasse das makro. sonst durchsuche eine bestimmten dateipfad inklusive aller unterordner. suche einen ordner, welcher den inhalt von spalte a im namen enthält. wenn ein ordner gefunden wurde, suche die datei Projektverlauf.one im entsprechenden ordner. wenn gefunden, folge dem pfad als hyperlink, ansonsten gib eine fehlermeldung aus.
Hier ist ein VBA-Makro, das die von Ihnen beschriebene Aufgabe erledigt:
Sub SearchForFile()
'Überprüfe, ob Spalte A leer ist
If Range("A1").Value = "" Then
MsgBox "Spalte A ist leer."
Exit Sub
End If
Dim folderPath As String
folderPath = "C:\Pfad\Zum\Übergeordneten\Ordner"
Dim targetFolderName As String
targetFolderName = "*" & Range("A1").Value & "*"
Dim targetFileName As String
targetFileName = "Projektverlauf.one"
Dim targetFolder As String
targetFolder = Dir(folderPath & "\" & targetFolderName, vbDirectory)
'Überprüfe, ob ein Ordner gefunden wurde
If targetFolder = "" Then
MsgBox "Kein Ordner mit dem Namen " & Range("A1").Value & " gefunden."
Exit Sub
End If
Dim filePath As String
filePath = folderPath & "\" & targetFolder & "\" & targetFileName
'Überprüfe, ob die Datei gefunden wurde
If Dir(filePath) = "" Then
MsgBox "Datei " & targetFileName & " nicht gefunden."
Exit Sub
End If
'Folge dem Pfad als Hyperlink
ThisWorkbook.FollowHyperlink filePath
End Sub
Sie müssen den Pfad zum übergeordneten Ordner und den Dateinamen im Code entsprechend anpassen. Fügen Sie auch den Code in das entsprechende Modul ein und weisen Sie ihm eine Schaltfläche oder ein Tastenkürzel zu, um es auszuführen.
der code soll sich auf die ganze spalte a beziehen und auf click reagieren
Okay, hier ist der aktualisierte Code, der auf den Klick in der Spalte A reagiert und die gesamte Spalte durchsucht:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Überprüfe, ob die ausgewählte Zelle in Spalte A ist
If Target.Column > 1 Then Exit Sub
'Überprüfe, ob die ausgewählte Zelle leer ist
If Target.Value = "" Then
MsgBox "Die ausgewählte Zelle ist leer."
Exit Sub
End If
Dim folderPath As String
folderPath = "C:\Pfad\Zum\Übergeordneten\Ordner"
Dim targetFolderName As String
targetFolderName = "*" & Target.Value & "*"
Dim targetFileName As String
targetFileName = "Projektverlauf.one"
Dim targetFolder As String
targetFolder = Dir(folderPath & "\" & targetFolderName, vbDirectory)
'Überprüfe, ob ein Ordner gefunden wurde
If targetFolder = "" Then
MsgBox "Kein Ordner mit dem Namen " & Target.Value & " gefunden."
Exit Sub
End If
Dim filePath As String
filePath = folderPath & "\" & targetFolder & "\" & targetFileName
'Überprüfe, ob die Datei gefunden wurde
If Dir(filePath) = "" Then
MsgBox "Datei " & targetFileName & " nicht gefunden."
Exit Sub
End If
'Folge dem Pfad als Hyperlink
ThisWorkbook.FollowHyperlink filePath
End Sub
Dieser Code wird in das Blattmodul eingefügt, auf dem die Spalte A vorhanden ist. Der Code wird automatisch ausgeführt, wenn eine Zelle in Spalte A ausgewählt wird, und sucht dann nach einem Ordner und einer Datei, die den Inhalt der ausgewählten Zelle enthalten. Wenn ein passender Ordner und eine passende Datei gefunden werden, wird der Pfad als Hyperlink gefolgt. Andernfalls wird eine Fehlermeldung angezeigt.
der gesuchte ordner kann sich auch in einem unterordner befinden. durchsuche auch sämtliche unterordner.
Hier ist der aktualisierte Code, der auch Unterordner durchsucht:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Überprüfe, ob die ausgewählte Zelle in Spalte A ist
If Target.Column > 1 Then Exit Sub
'Überprüfe, ob die ausgewählte Zelle leer ist
If Target.Value = "" Then
MsgBox "Die ausgewählte Zelle ist leer."
Exit Sub
End If
Dim folderPath As String
folderPath = "C:\Pfad\Zum\Übergeordneten\Ordner"
Dim targetFolderName As String
targetFolderName = "*" & Target.Value & "*"
Dim targetFileName As String
targetFileName = "Projektverlauf.one"
Dim targetFolder As String
targetFolder = FindFolder(folderPath, targetFolderName)
'Überprüfe, ob ein Ordner gefunden wurde
If targetFolder = "" Then
MsgBox "Kein Ordner mit dem Namen " & Target.Value & " gefunden."
Exit Sub
End If
Dim filePath As String
filePath = targetFolder & "\" & targetFileName
'Überprüfe, ob die Datei gefunden wurde
If Dir(filePath) = "" Then
MsgBox "Datei " & targetFileName & " nicht gefunden."
Exit Sub
End If
'Folge dem Pfad als Hyperlink
ThisWorkbook.FollowHyperlink filePath
End Sub
Function FindFolder(ByVal folderPath As String, ByVal targetFolderName As String) As String
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Dim folder As Object
Set folder = fso.GetFolder(folderPath)
Dim subFolder As Object
For Each subFolder In folder.SubFolders
If InStr(1, subFolder.Name, targetFolderName, vbTextCompare) > 0 Then
FindFolder = subFolder.Path
Exit Function
Else
Dim subTargetFolder As String
subTargetFolder = FindFolder(subFolder.Path, targetFolderName)
If subTargetFolder > "" Then
FindFolder = subTargetFolder
Exit Function
End If
End If
Next subFolder
FindFolder = ""
End Function
Der aktualisierte Code enthält eine separate Funktion namens "FindFolder", die den Ordnerpfad rekursiv durchsucht, um einen Ordner zu finden, der den Namen aus der ausgewählten Zelle enthält. Die Funktion gibt den Pfad des gefundenen Ordners zurück oder einen leeren String, wenn kein passender Ordner gefunden wurde.
Der restliche Code ist ähnlich wie zuvor, er überprüft, ob die Datei im gefundenen Ordner vorhanden ist und folgt dem Pfad als Hyperlink oder gibt eine Fehlermeldung aus.