Dir gibt nur eine Datei zurück

Liebes Forum, ich bin recht neu in VBA und verzweifle gerade an einer kleinen VBA-Aufgabe: Mit unterstehendem Macro möchte ich gerne aus mehreren Dateien in einem Ordner Bereiche in ein Arbeitsblatt einlesen. Grundsätzlich funktioniert das, allerdings nur für eine Datei. Wenn ich vor und hinter "QDatei = Dir()" per MsgBox den Wert von QDatei ausgeben lasse, bekomme ich vorher noch den Dateinamen der gerade ausgelesenen Datei, danach ist der Wert leer. Wenn ich die beiden For-Schleifen weglasse, werden dagegen alle Dateien ausgelesen. Irgendwo in den Schleifen scheint also der Denkfehler zu liegen und ich komme nicht darauf.
Für einen Tip, was ich falsch mache, wäre ich wahnsinnig dankbar. Eigentlich habe ich den Ehrgeiz, immer selbst die Lösung zu finden, aber Ich habe schon ein paar Abende herumprobiert und Foren durchsucht, komme aber hier nicht weiter. Hier nun mein Code:
Option Explicit
Sub Import()
Dim QPfad, QDatei, QBlatt As String, QBereich1, QBereich2 As Range, Zelle As Object, lastR As Integer
QPfad = ThisWorkbook.Path & Application.PathSeparator & "Projekte"
QBlatt = "Ressourcenplan"
Set QBereich1 = Range("B7:D11")
Set QBereich2 = Range("B1")
QDatei = Dir(QPfad & Application.PathSeparator & "*.xlsm")
Do
lastR = ActiveSheet.Range("B" & Application.Rows.Count).End(xlUp).Row
For Each Zelle In QBereich1
Zelle = Zelle.Address(False, False)
ActiveSheet.Cells(lastR + Zelle.Row - 5, Zelle.Column).Value = GetValue(QPfad, QDatei, QBlatt, Zelle)
Next Zelle
For Each Zelle In QBereich2
Zelle = Zelle.Address(False, False)
ActiveSheet.Cells(lastR + 2, 1).Value = GetValue(QPfad, QDatei, QBlatt, Zelle)
Next Zelle
QDatei = Dir()
Loop Until QDatei = ""
End Sub


Private Function GetValue(pfad, datei, blatt, zelle2)
Dim arg As String
arg = "'" & pfad & "[" & datei & "]" & blatt & "'!" & Range(zelle2).Range("A1").Address(, , xlR1C1)
GetValue = ExecuteExcel4Macro(arg)
End Function

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Code: [Cc][+][-] Option Explicit Public Sub Import() Dim QPfad As String, QDatei As String, QBlatt As String Dim astrFiles() As String Dim QBereich1 As Range, QBereich2 As Range, Zelle As Range Dim lastR As Long, ialngIndex As Long QPfad = ThisWorkbook.Path & Application.PathSeparator & "Projekte" QBlatt = "Ressourcenplan" Set QBereich1 = Range("B7:D11") Set QBereich2 = Range("B1") QDatei = Dir$(QPfad & Application.PathSeparator & "*.xlsm") Do Until QDatei = vbNullString ReDim Preserve astrFiles(ialngIndex) astrFiles(ialngIndex) = QDatei ialngIndex = ialngIndex + 1 QDatei = Dir$ Loop For ialngIndex = LBound(astrFiles) To UBound(astrFiles) lastR = ActiveSheet.Range("B" & Application.Rows.Count).End(xlUp).Row For Each Zelle In QBereich1 Zelle = Zelle.Address(False, False) ActiveSheet.Cells(lastR + Zelle.Row - 5, Zelle.Column).Value = _ GetValue(QPfad, astrFiles(ialngIndex), QBlatt, Zelle) Next Zelle For Each Zelle In QBereich2 Zelle = Zelle.Address(False, False) ActiveSheet.Cells(lastR + 2, 1).Value = _ GetValue(QPfad, astrFiles(ialngIndex), QBlatt, Zelle) Next Zelle Next End Sub Private Function GetValue(pfad, datei, blatt, zelle2) As String Dim arg As String arg = "'" & pfad & "[" & datei & "]" & blatt & "'!" & _ Range(zelle2).Range("A1").Address(, , xlR1C1) GetValue = ExecuteExcel4Macro(arg) End Function

Hallo Nepumuk und Yal, vielen Dank für Eure Vorschläge, ich bin erstmal begeistert von der schnellen Hilfe!
Ich habe den Code von Nepumuk getestet, funktioniert offenbar perfekt. Ich musste am Ende von der ersten Wertzuweisung für QPfad am Ende noch & Application.PathSeparator ergänzen, das hatte aber schon in meiner Vorgabe gefehlt, mein Fehler also.. Ich habe eine Ahnung davon, wie Deine Lösung funktioniert, muss es mir aber noch einmal genauer ansehen und das nachvollziehen, bis ich es ganz verstehe.
Dass irgendwo eine Variable "weiterzählt" oder so vermute ich auch, der "Reset" von Zelle hat aber leider spontan noch nicht geholfen. Auch da bleibe ich dran und werde mir auch "Microsoft Scripting Runtime" mal ansehen.
Problem also erst einmal umschifft, vielen Dank nochmals für Eure schnelle und großartige Hilfe. Wenn ich den ursprünglichen Fehler noch finde, werde ich hier berichten, vielleicht hilft es ja noch jemandem.
Bis bald,
Oliver

Beliebteste Forumthreads (12 Monate)

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread