Memoria esaurita

Hai un problema con Excel?

Nuova discussione

Memoria esaurita
di Fabio (utente non iscritto) data: 05/05/2017 14:06:38
Buongiorno a tutti,
ho un problema che non riesco a risolvere anche perchè sono poco preparato in Vba.
Ho realizzato un progetto che con diverse macro "concatenate" mi estrae dei dati da un file txt e me li copia in Excel.
Essendo numerose le righe da importare, con il vostro aiuto ho creato delle macro separate per ogni singolo blocco di righe da importare e che al termine lancia la macro successiva.
Il problema mi si crea quando la dimensione del file txt da aprire è di dimensioni importanti (3 - 4 mb), mi va in errore per "Memoria Esaurita".
Se avvio separatamente le macro non ho problemi ma se le lancio un automatico con "Call" va in errore. Se poi fermo la macro e la rifaccio ripartire funziona.
Evidentemente viene occupata della memoria che si libera solo se fermo la macro.
Concludendo, vi chiedo se esiste un sistema per liberare memoria tra una macro e quella successiva o, in alternativa, se esiste la possibilità di terminare la prima macro (così mi libera la memoria) e avviare automaticamente la successiva.
Purtroppo non ho la possibilità di dividere il file txt in quanto il numero delle righe cambia giornalmente.
Per cercare di essere più comprensibile, allego parte dei codici dove mi va in errore indicato con una nota.
Grazie e buona giornata.
Fabio

Sub APRI_FILE_3()     'Prima Macro
        Dim sFile As String, S As String, res As String, l As Long, posend As Long, posini As Long
    'Memorizza Directory File.txt e Agenzia
        direct = Sheets("menu").Range("D4").Value
        AGE = Sheets("MENU").Range("D6").Value
    'Identifica percorso e nome file
        Director = Application.ActiveWorkbook.Path 'Percorso File
        Nome_File = Application.ActiveWorkbook.Name 'Nome File
        fpath = ThisWorkbook.Path & ""
        Nome_File_txt = "File_ridotto.txt" 'Nome File Txt
    'Memorizza nome file da Aprire
        Sheets("TAB").Select
        Dim NomeFile As String
        Nome_File_Originale_txt = Range("E3").Value
        RIGA = Range("G2").Value
        Nome_File_Originale_txt = Range("E" & RIGA).Value
        fpath = ThisWorkbook.Path & ""
        sFile = direct & "" & Nome_File_Originale_txt
        ofile = fpath & "File_ridotto.txt"
        i = FreeFile
        l = FileLen(sFile)
        res = Space(l)
        Open sFile For Binary Access Read As #i
        Get #i, , res 
        Close i
        strSearch = Array(AGE, "NXWEB_TITOLO")
        strEnd = Array("DSC_ENTE_PUBB", "NXWEB_SINISTRI")
        For IND = 0 To 1
        posend = InStr(res, strEnd(IND))
        posini = InStr(res, strSearch(IND))
        S = S & Mid(res, posini, posend - posini)
        Next
        i = FreeFile
        Open ofile For Output As i
        Print #i, S
        Close i
        strSearch = Array(AGE, "NXWEB_TITOLO")
        strEnd = Array("DSC_ENTE_PUBB", "NXWEB_SINISTRI")
        For IND = 0 To 1
        posend = InStr(res, strEnd(IND))
        posini = InStr(res, strSearch(IND))
        S = S & Mid(res, posini, posend - posini)
        Next
        i = FreeFile
        Open ofile For Output As i
        Print #i, S
        Close i
        sFile = fpath & "File_Ridotto.txt"
        Workbooks.OpenText Filename:=sFile, Origin:=xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar:="|", FieldInfo:=Array( _
        Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15, 1)), TrailingMinusNumbers:=True
        FileRidotto = sFile
        S = ""
        .........
Call Apri_File_4
----------- 
-----------

Sub APRI_FILE_4()  'Seconda Macro
    Dim sFile As String, S As String, res As String, l As Long, posend As Long, posini As Long
    On Error GoTo ERRORE_14

    'Memorizza Directory File.txt e Agenzia
        direct = Sheets("menu").Range("D4").Value
        AGE = Sheets("MENU").Range("D6").Value
    'Identifica percorso e nome file
        Director = Application.ActiveWorkbook.Path 'Percorso File
        Nome_File = Application.ActiveWorkbook.Name 'Nome File
        fpath = ThisWorkbook.Path & ""
        Nome_File_txt = "File_ridotto.txt" 'Nome File Txt
    'Memorizza nome file da Aprire
        Sheets("TAB").Select
        Dim NomeFile As String
        Nome_File_Originale_txt = Range("E3").Value
        RIGA = Range("G2").Value
        Nome_File_Originale_txt = Range("E" & RIGA).Value
GARANZIE0:
    'Estrai dati e crea nuovo File Ridotto GARANZIE RISCHIO FATTORE
        fpath = ThisWorkbook.Path & ""
        sFile = direct & "" & Nome_File_Originale_txt
        ofile = fpath & "File_ridotto.txt"
        i = FreeFile
        l = FileLen(sFile)
        res = Space(l)
        Open sFile For Binary Access Read As #i
        Get #i, , res        '                                 ' PUNTO DOVE DA MEMORIA ESAURITA - res
        Close i
        strSearch = Array("NXWEB_RISCHIO_FATTORE")
        strEnd = Array("NXWEB_BENE_FATTORE")
        For IND = 0 To 0
        posend = InStr(res, strEnd(IND))
        posini = InStr(res, strSearch(IND))
        S = S & Mid(res, posini, posend - posini)
        Next
        i = FreeFile
        Open ofile For Output As i
        Print #i, S
        Close
        sFile = fpath & "File_Ridotto.txt"
    'Apri File Ridotto
        Workbooks.OpenText Filename:=sFile, Origin:= _
        xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar:="|", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 2), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1), Array(21, 1), Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), Array(27, 1), Array( _
        28, 1), Array(29, 2), Array(30, 1), Array(31, 1), Array(32, 1), Array(33, 1), Array(34, 2), Array(35, 1), Array(36, 2), Array(37, 1), Array(38, 2), Array(39, 1), Array(40, 2), Array(41, 1), Array(42, 1), Array(43, 1), Array(44, 1), Array(45, 1), Array(46, 2), Array(47, 1), Array(48, 1)), TrailingMinusNumbers:=True
        FileRidotto = sFile
        S = ""
        Nome_File_txt = Application.ActiveWorkbook.Name 'Nome File Txt
        Windows(Nome_File).Activate

di patel data: 05/05/2017 18:46:01
Allega il file, non troverai nessuno che abbia voglia di leggersi tutto quel codice

Vuoi Approfondire?