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.

    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 With

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:

    'ActiveSheet.QueryTables.Clear  
    'ActiveSheet.QueryTables.Delete  
    'ClearClipboard = True  
    'Application.CutCopyMode = False  

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

Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben

Content-ID: 174592

Url: https://administrator.de/contentid/174592

Ausgedruckt am: 26.11.2024 um 08:11 Uhr

1 Kommentar

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.

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