AW: Dateien auslesen in Tabelle
17.01.2016 21:20:01
Matthias
Hallo hier mal ein Codebeispiel, mit dem du rekursiv die Ordner durchgehen kannst. In dem Beispiel werden alle Dateien übernommen (Pfad + Dateiname) und in einem Datenfeld zwischengespeichert. Damit könntest du dir dann die Dateien in eine Liste eintragen und dann ggf. Filtern (Pfad ist ja dabei - wäre dann nur noch eine Stringbearbeitung). Man könnte den Code natürlich auch umschreiben und sich das gleich anders abspeichern, gleich eintragen lassen. Da ist dann nur die Frage, was soll verlinkt werden (jede Datei oder Ordner) und wie weit runter soll es gehen?
Schaue dir mal den Code an, vllt. hilft dir das ja weiter.
Viele Grüße
Dim dateien()
Option Explicit
Sub DateienLesen()
Dim DateiName As String
Dim quelle As String
Dim i As Long
Dim Dateialt As String
Dim Namekurz As String
Dim suche As Variant
Application.ScreenUpdating = False
Dateialt = ThisWorkbook.Name
ReDim dateien(0)
dateien(0) = 0
quelle = " " 'Pfad eintragen
If Right(quelle, 1) = "\" Then quelle = Left(quelle, Len(quelle) - 1)
If Dir(quelle & "\") = "" Then
MsgBox "Der Pfad wurde nicht gefunden!"
End
End If
Call txtsuchen(quelle)
If dateien(0) = 0 Then
MsgBox "Keine Dateien gefunden!"
Else
'Daten auslesen
For i = 1 To dateien(0)
DateiName = dateien(i) 'Pfad und Name
Namekurz = Right(DateiName, InStr(1, StrReverse(DateiName), "\") - 1)
Next i
End If
Application.ScreenUpdating = True
End Sub
Function txtsuchen(quelle As String)
Dim suche
Dim ordner()
Dim i As Long
ReDim ordner(0)
ordner(0) = 0
ChDrive (Left(quelle & "\", 3))
ChDir (quelle)
'Ordner durchschauen
suche = Dir(quelle & "\*.*", vbDirectory)
Do Until suche = ""
'Normale Dateien rausfiltern
If (GetAttr(quelle & "\" & suche) = 16) Then
'die hier ankommen, sind Ordner, extra speichern
ordner(0) = ordner(0) + 1
ReDim Preserve ordner(ordner(0))
ordner(ordner(0)) = suche
Else
dateien(0) = dateien(0) + 1
ReDim Preserve dateien(dateien(0))
dateien(dateien(0)) = quelle & "\" & suche
End If
suche = Dir()
Loop
'jetzt durch die Ordner gehen
For i = 1 To UBound(ordner)
If Dir(ordner(i), vbNormal) = "" And Left(ordner(i), 1) "." Then
Call txtsuchen(quelle & "\" & ordner(i))
ChDir (quelle)
End If
Next
End Function