Werte aus mehreren Dateien auslesen
07.11.2021 13:10:01
Sebastian
ich suche seit Tagen nach einer Lösung und komme nicht weiter.
Ich möchte aus mehreren Dateien, die auch in Unterordnern des angegebenen Ordners liegen, den Dateinamen und bestimmte Zellen auslesen. Dazu habe ich folgendes Makro gefunden, aber das Makro nimmt nur den aktuellen Ordner und nicht die Unterordner.
Ich habe gelesen das man dazu eine 2 Routine mit Call aufrufen muss, aber das übersteigt dann meine Fähigkeiten.
Könnt ihr mir hier bitte weiterhelfen? Ist eigentlich die Zeile zum auslesen des Dateinamens an der richtigen Stelle oder löst man das anders?
Danke im Voraus für eure Hilfe
Sebastian
Option Explicit
Const sXlsPath = "D:\Daten\Test"
Const iStartZeile = 3
Const iStartSpalte = 2
Const Zellen = "D8,D9"
Sub kopiereZellen()
Dim oFso As Object, oFile As Object, oWkb1 As Workbook, oWks0 As Worksheet, oWks1 As Worksheet
Dim aCells As Variant, iNextLine As Long, i As Integer
Set oWks0 = ThisWorkbook.ActiveSheet
aCells = Split(Zellen, ","): iNextLine = iStartZeile
Set oFso = CreateObject("Scripting.FilesystemObject")
For Each oFile In oFso.GetFolder(sXlsPath).Files
If LCase(oFso.GetExtensionName(oFile.Name)) = "xlsx" Then
If ThisWorkbook.path oFile.Name Then
Set oWkb1 = Workbooks.Open(oFile.path)
Set oWks1 = oWkb1.Sheets(1)
For i = 0 To UBound(aCells)
oWks0.Cells(iNextLine, iStartSpalte).Offset(0, i) = oWks1.Range(Trim(aCells(i))).Value
Next
oWks0.Cells(iNextLine, iStartSpalte).Offset(0, i) = oFile.Name
oWkb1.Close False
iNextLine = iNextLine + 1
End If
End If
Next
End Sub