QueryTables.Add in Excel Makro Arbeitsspeicher Excel wird rießig
Hallo,
ich hab ein Excel Makro das ca. 80 andere CSV-Excel-Dateien öffnet und den Inhalt in die aufrufende Excel(mir Makro)-Datei in jeweils ein neues Tabellenblatt importiert.
In "datei" steht halt der Pfad+Dateiname und in "name" nur der Dateiname.
Das hat bis gestern auch so funktioniert, ich konnte das Makro ausführen, 5min später war es fertig und ich konnte es speichern.
Jetzt wird das Makro zwar auch ausgeführt, aber ich kann es nicht mehr speichern. Ich vermute jetzt mal das das mit der Arbeitsspeichergröße von Excel (1.500.000K nach Ausführung des Makros) zu tun hat. Bisher ist mir das ja nie aufgefallen, jetzt wo ein Problem auftat hab ich das erst mit bekommen. Jetzt ist natürlich nicht schwer herauszufinden warum das so groß ist, ich mach ja rund 80 Excel Tabellen quasi auf.
Nun meine Frage, kann man des privaten Arbeitsspeicher von Excel mittels VBA begrenzen oder besser wieder freigeben (malloc oder sowas).
Hab in Google folgende Lösungen gefunden und unter das ActiveSheet.QueryTables.Add geschrieben, hat aber nichts gebracht:
Ich bin auch schon drauf gekommen dass, wenn ich .Refresh BackgroundQuery:=False auskommentiere, der Arbeitsspeicher nicht wächst, neur halt auch keine Tabellen importiert werden 
Lg David
ich hab ein Excel Makro das ca. 80 andere CSV-Excel-Dateien öffnet und den Inhalt in die aufrufende Excel(mir Makro)-Datei in jeweils ein neues Tabellenblatt importiert.
With ActiveSheet.QueryTables.Add(Connection:=datei, Destination:=Range("$A$1"))
.name = name
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 850
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = True
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
'.Delete ' Erst gestern durch probieren hinzugefügt, bringt aber nichts
End WithDas hat bis gestern auch so funktioniert, ich konnte das Makro ausführen, 5min später war es fertig und ich konnte es speichern.
Jetzt wird das Makro zwar auch ausgeführt, aber ich kann es nicht mehr speichern. Ich vermute jetzt mal das das mit der Arbeitsspeichergröße von Excel (1.500.000K nach Ausführung des Makros) zu tun hat. Bisher ist mir das ja nie aufgefallen, jetzt wo ein Problem auftat hab ich das erst mit bekommen. Jetzt ist natürlich nicht schwer herauszufinden warum das so groß ist, ich mach ja rund 80 Excel Tabellen quasi auf.
Nun meine Frage, kann man des privaten Arbeitsspeicher von Excel mittels VBA begrenzen oder besser wieder freigeben (malloc oder sowas).
Hab in Google folgende Lösungen gefunden und unter das ActiveSheet.QueryTables.Add geschrieben, hat aber nichts gebracht:
'ActiveSheet.QueryTables.Clear
'ActiveSheet.QueryTables.Delete
'ClearClipboard = True
'Application.CutCopyMode = FalseLg David
Antworten
- Mehr
Auf Facebook teilen
Auf Twitter teilen1 Antwort
- LÖSUNG davidl schreibt am 20.10.2011 um 12:05:11 Uhr
LÖSUNG 20.10.2011 um 12:05 Uhr
Hab gelöst indem ich für jede Tabelle, die ich einfüge, eine neue Mappe auf mache, dort die Daten importiere, die Daten verschiebe und die Mappe wieder schließe.
So bleibt der Arbeitsspeicher der "Hauptmappe" fast gleich weil die eine Mappe wo die Daten importiert werden, immer wieder geschlossen wird.
Hoffe das hilft wem.
So bleibt der Arbeitsspeicher der "Hauptmappe" fast gleich weil die eine Mappe wo die Daten importiert werden, immer wieder geschlossen wird.
Hoffe das hilft wem.
Dim Haupt_Mappenname As String
Dim Neben_Mappenname As String
Haupt_Mappenname = ActiveWorkbook.name
Workbooks.Add
Neben_Mappenname = ActiveWorkbook.name
With ActiveSheet.QueryTables.Add(Connection:=datei, Destination:=Range("$A$1"))
.name = name
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 850
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = True
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Range("A1:AT3010").Select
Selection.Copy
Windows(Haupt_Mappenname).Activate
Range("A1").Select
ActiveSheet.Paste
Windows(Neben_Mappenname).Activate
OpenClipboard FindWindow("xlMain", vbNullString)
EmptyClipboard
CloseClipboard
ActiveWindow.Close (False)
Windows(Haupt_Mappenname).Activate
