Datei suchen und als Hyperlink einfügen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo, Heinz,
Hier das Programm, zu dem ich allerdings die Vorwarnung mitliefern muß, dass ich nicht die Zeit finde, es zu testen. Daher bitte nur einsetzen wenn Du einigermaßen Rückschläge in Kauf nehmen kannst (ggf. einfach unter einer neuen Kommando-Schaltfläche anlegen).
Suche Datei im Ausgangs- und zugehörige Unterverzeichnisse:

Private Sub CommandButton2_Click()
Dim rngC As Range, strPfad As String, strFName as string, fanz as integer
Set rngC = Cells(ActiveCell.Row, 3)
strPfad = "L:\Musik\Musik\"
strFName = rngC.Offset(0, 2).Value
with Application.FileSearch
.lookin = strPfad ' setze Ausgangspfad
.searchSubFolder = true ' bindet Unterverzeichnisse in den Suchvorgang
.Filename = fname 'setzt den Suchnamen
anzf = .Execute 'führt FileSearch aus und liefert Anzahl der Funde,
' in anzf gespeichert
if not anzF =1 then 'mehr als ein Fund oder aber kein Fund
msg= "Datei " & fname & " existiert " & _
IIF(anzF > 1; "mehrmals";"nicht") & "!"
msgbox msg
else
strFName = .FoundFiles(1) 'vollständiger Pfad-Dateiname
ActiveSheet.Hyperlinks.Add _
Anchor:=rngC, _
Address:=strFName, _
TextToDisplay:=rngC.Value
end if
set rngC=Nothing
End Sub

Nun hoffe ich also, dass nicht unüberwindbare Fehler im Programmcode enthalten sind.
Gruß,
Uwe

Option Explicit Private Sub CommandButton2_Click() Dim rngC As Range, strPfad As String, strFName As String, anzF As Integer, msg As String Set rngC = Cells(ActiveCell.Row, 3) strPfad = "L:\Musik\Musik\" strFName = rngC.Offset(0, 2).Value With Application.FileSearch .LookIn = strPfad ' setze Ausgangspfad .SearchSubFolders = True ' bindet Unterverzeichnisse in den Suchvorgang .Filename = strFName 'setzt den Suchnamen anzF = .Execute 'führt FileSearch aus und liefert Anzahl der Funde, ' in anzf gespeichert If Not anzF = 1 Then 'mehr als ein Fund oder aber kein Fund msg = "Datei " & strFName & " existiert " & IIf(anzF > 1, "mehrmals", "nicht") & "!" MsgBox msg Else strFName = .FoundFiles(1) 'vollständiger Pfad-Dateiname ActiveSheet.Hyperlinks.Add _ Anchor:=rngC, _ Address:=strFName, _ TextToDisplay:=rngC.Value End If Set rngC = Nothing End With End Sub Viel Erfolg! Uwe

Beliebteste Forumthreads (12 Monate)

Datei suchen und als Hyperlink einfügen

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

305 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Datei suchen und als Hyperlink einfügen

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

305 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread