Umwandlung FileSearch
10.06.2020 09:59:18
maxim
ich habe hier folgenden Code von ingUR in einem alten Beitrag gefunden. Ich würde den gerne mal auf mein Problem anwenden, aber der Befehl FileSearch ist nicht verfügbar in meiner Version. Ich habe im Internet nach Lösungen gesucht, aber blicke da nicht durch, wie ich diese in den Code implementiere.
Ich weiß auch noch nicht ob der Code bei meinem Problem etwas taugt.
Problemstellung:
Ich möchte, dass in einem Ordner und dessen Unterordnern nach Dateinamen gesucht wird und diese dann mit einem Hyperlink versehen werden. Die Dateinamen befinden sich dabei in Spalte P und der Hyperlink soll in Spalte F gesetzt werden.
https://www.herber.de/bbs/user/138017.xlsx
In der Beigefügten Mappe ist der Tabellen Kopf meiner Tabelle abgebildet.
Könnte mir da jemand bitte mit weiterhelfen?
Liebe Grüße
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, 6)
strPfad = "R:\KM\KMM\M40.0 Anlagendoku\10 D1 Reservekessel"
strFName = rngC.Offset(0, 10).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