如何修复运行时错误"7"内存不足，即使在保存，关闭，重新启动计算机后仍然存在

Question

我的excel vba宏产生"运行时错误'7'：of of moremor"

Excel文档在一张纸中包含5500个CSV文档的列表。宏通过此列表，每个列表：a）将其信息放入合并的输出表中；b）添加一些公式；c）继续下一个文件。

完成了大约3,000个后，脚本遇到了内存错误。

主要问题是，保存文件后仍然存在此问题，完全关闭Excel，重新打开Excel，甚至重新启动计算机。我还使用糊剂特殊情况来摆脱所有公式，并替换为值。我还切换到手动计算。

我想找到一种方法来防止此错误发生。至少，如果发生这种情况，我希望能够保存，关闭和重新打开文件，并一次继续浏览列表3,000个条目。

我已经阅读了有关内存错误的所有以前的问题和答案，但是在关闭和重新打开后似乎没有问题持续存在。

我在下面发布了我的代码的相关部分。调试器显示错误发生在线上：.refresh BackgroundQuery：= false。我正在运行Windows 10，Excel2007。任何帮助都将不胜感激。谢谢！

Sub test()
Dim filename As String
Dim outputsheet As String
Dim output_lastrow As Integer
Application.EnableEvents = False
For rep = 2 To 5502
    filename = Sheets("Import Files").Range("A" & rep).Value ‘this takes the form of C:Users...filename1.csv
    outputsheet = "Summary"
    output_lastrow = Sheets(outputsheet).Range("D999999").End(xlUp).Row
    With ActiveSheet.QueryTables.Add(Connection:="TEXT;" + filename, Destination:=Sheets(outputsheet).Range("$A" & output_lastrow + 2))
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .TextFilePromptOnRefresh = False
            .TextFilePlatform = 437
            .TextFileStartRow = 1
            .TextFileParseType = xlDelimited
            .TextFileTextQualifier = xlTextQualifierDoubleQuote
            .TextFileConsecutiveDelimiter = False
            .TextFileTabDelimiter = False
            .TextFileSemicolonDelimiter = False
            .TextFileCommaDelimiter = True
            .TextFileSpaceDelimiter = False
            .TextFileTrailingMinusNumbers = True
            .Refresh BackgroundQuery:=False
    End With
        output_lastrow = Sheets(outputsheet).Range("D999999").End(xlUp).Row + 1
        Sheets(outputsheet).Range("A" & output_lastrow).Value = "Change"
        Sheets(outputsheet).Range("B" & output_lastrow).Formula = "=R[-1]C"
        Sheets(outputsheet).Range("C" & output_lastrow).Formula = "=R[-1]C"
        Sheets(outputsheet).Range("C" & output_lastrow).AutoFill Destination:=Range("C" & output_lastrow & ":FP" & output_lastrow), Type:=xlFillDefault
    End If
    Dim wbconnection As WorkbookConnection
    For Each wbconnection In ActiveWorkbook.Connections
        If InStr(filename, wbconnection.Name) > 0 Then
            wbconnection.Delete
        End If
    Next wbconnection
Next rep

Answer 1

，因为您可以在"只有在只有"模式下使用Workbooks.Open打开CSV文件，然后像从普通工作表中复制数据，请尝试以下操作：

Sub Test()
    Dim filename As String
    Dim outputsheet As String
    Dim output_lastrow As Integer
    Dim wbCSV AS Workbook
    outputsheet = "Summary"
    Application.EnableEvents = False
    For rep = 2 To 5502
        filename = Sheets("Import Files").Cells(rep, 1).Value ‘this takes the form of C:Users...filename1.csv
        output_lastrow = Sheets(outputsheet).Cells(Sheets(outputsheet).Rows.Count, 4).End(xlUp).Row
        'Open CSV File
        Set wbCSV = Workbooks.Open(Filename:=filename, ReadOnly:=True)
        'Copy data to outputsheet
        wbCSV.Worksheets(1).UsedRange.Copy Destination:=ThisWorkbook.Sheets(outputsheet).Cells(output_lastrow + 1, 1)
        'Close CSV File
        wbCSV.Close False
        Set wbCSV = Nothing
    Next rep
    Application.EnableEvents = True
End Sub

如果您将rep存储在工作簿中的某个地方，并且经常保存它（ThisWorkbook.Save），那么即使它确实崩溃，您也可以从保存的最后一点恢复循环