Hallo Leute!
hier is mein VBA Code:
Sub dateneinlesen()
Dim strDateiname As String, strPfadname As String, suchString As String
Dim myZeile, dataZeile As Long
Dim ListDateiname(100) As String
Application.ScreenUpdating = False
Dim dataZeileZelle As String
Dim myZeileZelle As String
myZeile = 1
suchString = "rbpl ACCOUNT"
Dim myWorkbook, dataWorkbook As Workbook
Set myWorkbook = ActiveWorkbook
strPfadname = "K:\ALC\User\msu\RBPL_TimeSeries\krmport\"
strDateiname = Dir(strPfadname & "*.csv")
Do Until strDateiname = ""
Set dataWorkbook = Workbooks.Open(strPfadname & strDateiname)
dataZeile = 3
dataZeileZelle = dataWorkbook.Sheets(1).Cells(dataZeile, 1)
Do Until dataZeileZelle = ""
If InStr(1, dataZeileZelle, suchString) Then
myWorkbook.Sheets(1).Cells(myZeile, 1) = dataZeileZelle
myZeile = myZeile + 1
End If
dataZeile = dataZeile + 1
dataZeileZelle = dataWorkbook.Sheets(1).Cells(dataZeile, 1)
Loop
dataWorkbook.Close
strDateiname = Dir
Loop
Application.ScreenUpdating = True
End Sub
Ich habe die Dateien zusammenkopiert in den Ordner, welche im schnitt um die 200000 Zeilen haben! Dann möchte ich alle Zeilen welche den Suchstring enthalten in meinen datei Kopieren, damit ich sie später in eine DB füttern kann!
Leider wird mein Speicher immer größer, bis er mir irgendwann einen Fehler bei folgender Zeile wirft:
myWorkbook.Sheets(1).Cells(myZeile, 1) = dataZeileZelle
Es funktioniert ca bis zur 6 Datei, dann bricht es leider ab! Jede Datei hat über 100 MB :/
Hoffe ihr könnt mir helfen. LG
|