Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1608to1612
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Dateiliste mit Hyperlinks

Dateiliste mit Hyperlinks
22.02.2018 15:24:25
Basti
Hallo Leute,
hab hier http://www.ms-office-forum.net/forum/showthread.php?t=278587
einen Code von Sepp gefunden, der alle Dateien, in meinem Fall .xlsx, aus einem definierten Order auslesen soll und diesen Dateiname + Hyperlink in das aktuelle Tabellenblatt einfügt.
Der Code läuft anscheinend durch, aber liefert bei mir kein Ergebnis im aktuellen Arbeitsblatt.
Habt Ihr eine Erklärung, liegt es evtl. an meiner Excel Version 14.0?
Sub makeLink()
Dim objFiles() As Object
Dim lngRet As Long, lngIndex As Long
Dim vntRet As Variant
Dim rng As Range
Dim strPath As String, strFile As String
strPath = "C:\Users\Documents\Desktop\" 'Stammverzeichnis - Anpassen!
lngRet = FileSearchINFO(objFiles, strPath, "*.xls*", True)
If lngRet > 0 Then
With ActiveSheet 'oder With Sheets("Tabelle1")
For lngIndex = 0 To lngRet - 1
strFile = objFiles(lngIndex).Name
vntRet = Application.Match(Left(strFile, Len(strFile) - 4), .Columns(3), 0)
If IsNumeric(vntRet) Then
.Hyperlinks.Add Anchor:=.Cells(vntRet, 3), Address:=CStr(objFiles(lngIndex))
End If
Next
End With
End If
End Sub
Private Function FileSearchINFO(ByRef Files() As Object, ByVal InitialPath As String, Optional   _
_
_
ByVal FileName As String = "*.xlsx", _
Optional ByVal SubFolders As Boolean = False) As Long
'# PARAMETERINFO:
'# Files: Datenfeld zur Ausgabe der Suchergebnisse
'# InitialPath: String der das zu durchsuchende Verzeichnis angibt
'# FileName: String der den gesuchten Dateityp oder Dateinamen enthält (Optional, Standard="*. _
_
_
*" findet alle Dateien)
'# Beispiele: "*.txt" - Findet alle Textdateien
'# "*name*" - Findet alle Dateien mit "name" im Dateinamen
'# "*.avi;*.mpg" - Findet .avi und .mpg Dateien (Dateitypen mit ; trennen)
'# SubFolders: Boolean gibt an, ob Unterordner durchsucht werden sollen (Optional, Standard=   _
_
_
False)
Dim fobjFSO As Object, ffsoFolder As Object, ffsoSubFolder As Object, ffsoFile As Object
Dim intC As Integer, varFiles As Variant
Set fobjFSO = CreateObject("Scripting.FileSystemObject")
Set ffsoFolder = fobjFSO.GetFolder(InitialPath)
On Error GoTo ErrExit
If InStr(1, FileName, ";") > 0 Then
varFiles = Split(FileName, ";")
Else
ReDim varFiles(0)
varFiles(0) = FileName
End If
For Each ffsoFile In ffsoFolder.Files
If Not ffsoFile Is Nothing Then
For intC = 0 To UBound(varFiles)
If LCase(fobjFSO.GetFileName(ffsoFile)) Like LCase(varFiles(intC)) Then
If IsArray(Files) Then
ReDim Preserve Files(UBound(Files) + 1)
Else
ReDim Files(0)
End If
Set Files(UBound(Files)) = ffsoFile
Exit For
End If
Next
End If
Next
If SubFolders Then
For Each ffsoSubFolder In ffsoFolder.SubFolders
FileSearchINFO Files, ffsoSubFolder, FileName, SubFolders
Next
End If
If IsArray(Files) Then FileSearchINFO = UBound(Files) + 1
ErrExit:
Set fobjFSO = Nothing
Set ffsoFolder = Nothing
End Function
Vielen Dank für die Hilfe.
Gruß
Basti

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Dateiliste mit Hyperlinks
22.02.2018 15:44:24
Dieter(Drummer)
Hallo Basti,
hier eine tolle Version für dein Problem. Dies habe ich aus diesem Forum erhalten und hat tolle Varianten.
https://www.herber.de/bbs/user/120005.xlsm
Gruß, Dieter(Drummer)
AW: Dateiliste mit Hyperlinks
22.02.2018 16:33:38
Basti
Servus Dieter,
vielen Dank für den Hinweis.
Übererfüllt meine Anforderungen ;-)
Gruß
Basti
AW: OK. Danke für Rückmeldung. Gruß. owT
22.02.2018 17:28:33
Dieter(Drummer)
Anzeige

297 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige