|
So sieht die Script aktuell aus:
Dim fso As Object
Sub ImportData()
Dim col As New Collection, file As Variant, wb As Workbook, rngDest As Range, ws As Worksheet, rngSource As Range
'Ordner der die Dateien enthält
Const FOLDER = "C:\Users\****\Desktop\test auslesen"
'Filesystemobject
Set fso = CreateObject("Scripting.
FileSystemObject")
'alle Excel-Dateien rekursiv listen
getAllFiles fso.GetFolder(FOLDER), True, Array("xlsx", "xls"), col
'Screenupdates und eventuelle Dialoge für Batchbetrieb unterdrücken
Application.DisplayAlerts = False
Application.ScreenUpdating = False
With Sheets(1)
'Für jede Excel-Datei
For Each file In col
'nächste freie Zelle in Spalte A ermitteln
Set rngDest = .Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
'mit erstem Sheet des Workbooks arbeiten
With GetObject(file).Sheets(1)
' Wenn C2 nicht leer ist
If .Range("C2").Value <> "" Then
'Daten ermitteln
Set rngSource = .Range("D3:H" & .Cells(Rows.Count, "D").End(xlUp).Row)
'Wenn Daten vorhanden sind
If rngSource.Rows.Count > 1 Then
' exclude die Überschriften
Set rngSource = rngSource.Offset(1)
' Kopiere die Daten ins Ziel
rngSource.Copy rngDest.Offset(0, 1)
' Setze Datum vor die Zeilen
rngDest.Resize(rngSource.Rows.Count - 1).Value = .Range("C2").Value
End If
End If
'Workbook schließen
.Parent.Close False
End With
Next
End With
'Screenupdates und Dialoge wieder einschalten
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Sub getAllFiles(ByVal fldr As Object, boolRecursion As Boolean, arrFileExtensions As Variant, ByRef col As Collection)
For Each file In fldr.Files
For i = 0 To UBound(arrFileExtensions)
If LCase(arrFileExtensions(i)) = LCase(fso.GetExtensionName(file.Path)) Then
col.Add file.Path
Exit For
End If
Next
Next
If boolRecursion Then
For Each subFolder In fldr.SubFolders
getAllFiles subFolder, True, arrFileExtensions, col
Next
End If
End Sub
Sie hat ein paarmal funktioniert und seit dem bekomme ich auf Laufzeitfehler 1004 bei:
Set rngSource = .Range("D3:H" & .Cells(Rows.Count, "D").End(xlUp).Row)
was mache ich falsch?? Sie soll nach wie vor den ausgewählten Ordner und dessen Unterordner durchsuchen.
Und was muss ich ändern, dass die Datei nur Zahlen schreibt und nicht die Formeln mit aus den zu durchsuchenden Excel Dateien zieht?!
Danke und Gruß
|