worddateien aus Verzeichnis auflisten

Hallo Leute,
ich komm leider nicht weiter, vielleicht könnt Ihr mir mal helfen. Ich möchte in einer Excel-Datei per Makro alle Worddateien auflisten die sich in einem bestimmten Verzeichnis befinden. Hab da auch was gefunden, aber es funktioniert nicht so richtig.
Das Verzeichnis und der Pfad stehen in B1, die gefundenen Dateien sollen ab B36 aufgelistet werden. Am besten wäre noch ein Hyperlink, damit man die Dateien direkt von dort aus öffnen könnte. Das krieg ich leider mit meinem Halbwissen nicht hin.
Dim arr As Variant
Dim sPath As String, sPattern As String
Dim sFile As String


Sub Einlesen()
sPath = "Range(B1)"
sPattern = "*.doc"
arr = arrAll(sPath, sPattern)
For iCounter = 1 To UBound(arr)
Cells(iCounter, 1) = sPath & arr(iCounter)
Next iCounter
End Sub




Function arrAll(sPath As String, sPattern As String) As Variant

Dim arr()

If Right(sPath, 1)  "\" Then sPath = sPath & "\"

sFile = Dir(sPath & sPattern)

Do While sFile  ""

iCounter = iCounter + 1

ReDim Preserve arr(1 To iCounter)

arr(iCounter) = sFile

sFile = Dir()

Loop

arrAll = arr

End Function

Vielen Dank schonmal!
LG
Silvie

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Option Explicit Sub Einlesen() Dim sPath As String, sPattern As String, rngC As Range, arr sPath = Range("B1").Value sPattern = "*.doc" arr = arrAll(sPath, sPattern) Cells(36, 2).Resize(UBound(arr) + 1) = Application.Transpose(arr) For Each rngC In Cells(36, 2).Resize(UBound(arr) + 1).Cells ActiveSheet.Hyperlinks.Add _ Anchor:=rngC, _ Address:=rngC.Text, _ TextToDisplay:=rngC.Text Next End Sub Function arrAll(sPath As String, sPattern As String) As Variant Dim objFiles As Object, sFile As String Set objFiles = CreateObject("Scripting.dictionary") If Right(sPath, 1) "\" Then sPath = sPath & "\" sFile = Dir(sPath & sPattern) Do While sFile "" objFiles(sPath & sFile) = 0 sFile = Dir() Loop arrAll = objFiles.Keys End Function

Option Explicit ' immer zu empfehlen Sub Einlesen() Dim sPath As String, sPattern As String Dim arr As Variant, iCounter As Long sPath = Range("B1").Value sPattern = "*.dcc" arr = arrAll(sPath, sPattern) If IsArray(arr) Then For iCounter = 1 To UBound(arr) Cells(iCounter + 35, 2) = sPath & arr(iCounter) Next iCounter Else MsgBox "Keine Ausgabe" End If End Sub Function arrAll(sPath As String, sPattern As String) As Variant Dim sFile As String, arr() As String, iCounter As Long If Right(sPath, 1) "\" Then sPath = sPath & "\" sFile = Dir(sPath & sPattern) If sFile = "" Then MsgBox "Keine Datei " & sPath & sPattern & " gefunden" arrAll = False Else Do While sFile "" iCounter = iCounter + 1 ReDim Preserve arr(1 To iCounter) arr(iCounter) = sFile sFile = Dir() Loop arrAll = arr End If End Function

Beliebteste Forumthreads (12 Monate)

worddateien aus Verzeichnis auflisten

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread