Thema Datum  Von Nutzer Rating
Antwort
09.07.2016 13:08:44 Gast100,2
NotSolved
09.07.2016 15:43:38 Gast34990
NotSolved
10.07.2016 09:20:22 Gast100,2
NotSolved
Blau Hyperlink relativ Aufrufen
10.07.2016 12:49:19 Gast75090
NotSolved

Ansicht des Beitrags:
Von:
Gast75090
Datum:
10.07.2016 12:49:19
Views:
729
Rating: Antwort:
  Ja
Thema:
Hyperlink relativ Aufrufen

Moin! Also hier mal eine Variante. War mir nicht sicher, wie flexibel es sein soll und ob du den Unterordnernamen bzw. den Namen der dort befindelichen Datei schon hast oder nicht. Im Code einfach mal die Kommentare beachten. Wenn du die Namen nicht weißt, werden sie ausgelesen. Aber aufpassen, falls es mehrere Ordner bzw. dann DAteien gibt, wird immer der/die erste genommen. Falls du die Namen hast, dann einfach im Code an der bezeichneten Stelle ergänzen und den Rest rauslöschen. Bei Link ggf. noch anpassen, wo der genau hin soll. Schönen Sonntag noch

 

Option Explicit

Sub hyperlink_dynamisch()
Dim aktuellerpfad As String
Dim fso As Object
Dim unterordner As Object
Dim ordner As Object
Dim nordner As String
Dim dateien As Object
Dim datei As Object
Dim dateiname As String

'der Pfad in dem deine Datei liegt
aktuellerpfad = Left(ActiveWorkbook.FullName, InStrRev(ActiveWorkbook.FullName, "\"))
If Right(aktuellerpfad, 1) <> "\" Then aktuellerpfad = aktuellerpfad & "\"

'##########################################################################
'falls du den Namen des Ordners und der Datei kennst, kann du die direkt einfügen, dann hier ergänzen und den Kommentar Apostroph rausnehmen
'für den Unterordner ohne \ am Ende
'nordner = DeinUnterordner
'für die Datei
'dateiname = deinName
'falls nicht sucht der Code hier den ersten Unterordner und darin die erste Datei

Set fso = CreateObject("Scripting.Filesystemobject")
'Unterordner aussuchen, der Name des ersten gefunden Ordner steht in nordner
Set unterordner = fso.GetFolder(aktuellerpfad).subfolders

For Each ordner In unterordner
    nordner = ordner.Name
    Exit For
Next ordner

If nordner = "" Then
    MsgBox "Kein Ordner vorhanden!", , "Keinen Ordner gefunden"
    End
End If

'jetzt erste Datei in dem Unterordner suchen, steht dann in dateiname
Set dateien = fso.GetFolder(aktuellerpfad & nordner)

For Each datei In dateien.Files
    dateiname = datei.Name
    Exit For
Next datei

If dateiname = "" Then
    MsgBox "Keine Datei vorhanden!", , "Keine Datei gefunden"
    End
End If


'falls du die Daten kanntest, kannst du bis hier rauslöschen
'#############################################################################

'Hyperlink einfügen
ActiveSheet.Hyperlinks.Add Anchor:=ActiveSheet.Range("A1"), Address:=aktuellerpfad & nordner & "\" & dateiname, _
        TextToDisplay:=aktuellerpfad & nordner & "\" & dateiname


End Sub

 


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
09.07.2016 13:08:44 Gast100,2
NotSolved
09.07.2016 15:43:38 Gast34990
NotSolved
10.07.2016 09:20:22 Gast100,2
NotSolved
Blau Hyperlink relativ Aufrufen
10.07.2016 12:49:19 Gast75090
NotSolved