Office: Datenauswertung über Unterordner

Einen wunderschönen guten Tag!

Evtl. weiss von Euch jemand eine Lösung. Ich möchte ein Makro schreiben, welches aus Dateien, die in mehreren Unterordnern (nur eine Ebene unterhalb und immer nur eine Datei pro Ordner) stehen, immer aus demselben Feld Werte ausliest. Erst sollte geprüft werden, ob es sich um eine korrekte Datei handelt (indem z.B. der Name des Tabellenblatts geprüft wird, der immer gleich lautet). Wenn die Datei korrekt ist, dann sollte der Name der Datei in die Excel-Tabelle geschrieben werden.
Dann werden einzelne Werte (immer aus denselben Zellen) ausgelesen und dann entlang der Ordnerstruktur zum nächsten Ordner gewechselt werden, bis alle Unterordner ausgelesen sind.

Ordner mit Konsolidierungsdatei
Unterordner A mit Auslesdatei
Unterordner B mit Auslesdatei
Unterordner C mit Auslesdatei
etc.

Ich wäre sehr dankbar, wenn mr jemand einen Tipp geben könnte.
Sonnige Grüsse aus der Schweiz


Hier das Makro zum Auslesen, wenn alle Dateien im selben Ordner wären. Es dürften dann aber nur auswertbare Dateien in dem Ordner stehen. Dies soll mit dem neuen Makro eben nicht so sein, d.h. in den Unterordnern können auch andere Dateien vorhanden sein. Mit der Prüfung der Existenz eines bestimmten Tabellenblattes sollten nur die richtigen Dateien ausgewertet werden.


Code:

:)

 

Leider konnte mir niemand bislang helfen. Ich habe versucht die Problematik des Durchsuchen der Unterordner zu lösen, trotzdem funktioniert es nicht.

Kann mir jemand sagen, wo der Haken ist und wie es zu lösen ist. Verbringe schon Stunden damit, doch es wird nicht besser.

Danke für einen Tipp!

HTML:

Sub Konsolidierung2()

Dim MySheet As Worksheet ' aktuelles Arbeitsblatt
Dim strPath As String ' Dateipfad zum Auslesen der Dateien
Dim strFile As String ' Quelldatei
Dim wkbInput, meins As Workbook ' Quell-Arbeitsmappe
Dim wksInput As Worksheet ' Quell-Registerblatt
Dim lngTargetRow As Long ' Zeilenzähler für die Bewertungsinformationen
Dim lRow As Long ' Schleifenzähler
Dim lCol As Long ' Schleifenzähler
Dim delta As Integer

Application.DisplayAlerts = False

delta = 0
Set MySheet = ActiveSheet
Set meins = ActiveWorkbook


Dim strPfad As String
Dim intI As Integer
Dim intAnz As Integer

strPfad = "I:\Testordner\"        'Wichtig: \ am Ende

With Application.FileSearch

.LookIn = strPfad
.NewSearch
.SearchSubFolders = True
.Filename = "*.xls"
.Execute

intAnz = .FoundFiles.Count

For intI = 1 To intAnz


'-------------------------------------'
' Verzeichnisse durchgehen und alle Dateien auslesen '-------------------------------------'

If strFile = ActiveWorkbook.Name Then
'-------------------------------------'
' Zieldatei natürlich übergehen
'-------------------------------------'

Else

Sheets(1).Cells(intI, 1).Value = .FoundFiles(intI)
'-------------------------------------'
' Quelldatei öffnen
' und Registerblatt prüfen
'-------------------------------------'


Set wkbInput = Application.Workbooks.Open(strPath & "\" & strFile)
Set wksInput = wkbInput.Worksheets("Lcockpit")


'-------------------------------------'
' Daten auslesen und in Auswertung kopieren '-------------------------'

' Ist Situation effektiv - Monat
wksInput.Activate
wksInput.Select
wksInput.Cells(33, 4).Select
Selection.Copy
meins.Activate
MySheet.Activate
MySheet.Cells(5 + delta, 2).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False


delta = delta + 1


'-------------------------------------'
' Datei schließen
'-------------------------------------'
wkbInput.Close
Set wkbInput = Nothing

End If

Next intI          'PPFR

End With         ' PPFR


MsgBox "Abgeschlossen"


End Sub

 

Hallo yves,
ich hab mal folgendes zur Auswertung von Verzeichnissen erstellt.
Hier werden alle Dateien aus den verzeichnissen in einer Excelmappe aufgelistet.
Anschließend habe ich aus dieser Liste die dateien nacheinander abgearbeitet (das waren damals CSV dateien und hier wurden einzelne Sätze rausgefiltert)
probiers einfach mal
mach ne leere Excel tabelle auf und kopiere den Code in ein neues Modul

Code:

Gruß
Debabba

 

Danke, es hat geklappt!