使用VBA导入文本文件时，Excel内存不足警告

当通过VBA导入多个txt文件到Excel中时，会遇到与.Refresh BackgroundQuery:=False相关的内存不足警告。 正确导入的文本文件正好723popup错误。

这是我使用的VBA代码：

 Sub Sample() Dim myfiles Dim i As Integer myfiles = Application.GetOpenFilename(filefilter:="Text files (*.txt), *.txt", MultiSelect:=True) If Not IsEmpty(myfiles) Then For i = LBound(myfiles) To UBound(myfiles) With ActiveSheet.QueryTables.Add(Connection:= _ "TEXT;" & myfiles(i), Destination:=Range("A" & Rows.Count).End(xlUp).Offset(1, 0)) .Name = "Sample" .FieldNames = False .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = True .RefreshStyle = xlInsertDeleteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .TextFilePromptOnRefresh = False .TextFilePlatform = 437 .TextFileStartRow = 1 .TextFileParseType = xlDelimited .TextFileTextQualifier = xlTextQualifierDoubleQuote .TextFileConsecutiveDelimiter = True .TextFileTabDelimiter = False .TextFileSemicolonDelimiter = False .TextFileCommaDelimiter = False .TextFileSpaceDelimiter = False .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1) .TextFileTrailingMinusNumbers = True .Refresh BackgroundQuery:=False End With Next i Else MsgBox "No File Selected" End If End Sub 

我该如何解决这个问题？

Answer 1

我相信这与caching大小，页面大小和每页logging有关。 如果您尝试以下代码objRecordset.Open“SELECT * FROM”＆CSV_FILE，objConnection，adOpenStatic，adLockOptimistic，adCmdText

 If Not objRecordset.EOF Then intpagecount = objRecordset.PageCount MsgBox intpagecount MsgBox objRecordset.PageSize Debug.Print objRecordset.CacheSize 

万一

在一个大的CSV文件上，你会发现VBA总是在每个页面的末尾显示一个内存已满的错误。 在这种情况下，每页有10条logging，50585页。 果然，我在每页10 * 50585 = 505850logging得到一个内存完整。

Answer 2

您可能在工作簿中有许多连接，因为您不断添加它们，但是之后不会删除它们。

试试这个，但首先运行Sub CleanUpQT()作为一个。 此外，您的一些范围不完全合格，如果您在代码运行时更改工作表，将会导致问题。 使用Set ws = Sheet1 – 将Sheet1设置为代号或类似值，将其Set ws = Sheet1为您要使用的Set ws = Sheet1一张表。

 Option Explicit Sub Sample() Dim myfiles As Variant Dim i As Integer Dim temp_qt As QueryTable Dim ws As Worksheet myfiles = Application.GetOpenFilename(filefilter:="Text files (*.txt), *.txt", MultiSelect:=True) If Not IsEmpty(myfiles) Then Set ws = Sheet1 For i = LBound(myfiles) To UBound(myfiles) Set temp_qt = ws.QueryTables.Add(Connection:= _ "TEXT;" & myfiles(i), Destination:=ws.Range("A" & ws.Rows.Count).End(xlUp).Offset(1, 0)) With temp_qt .Name = "Sample" .FieldNames = False .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = True .RefreshStyle = xlInsertDeleteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .TextFilePromptOnRefresh = False .TextFilePlatform = 437 .TextFileStartRow = 1 .TextFileParseType = xlDelimited .TextFileTextQualifier = xlTextQualifierDoubleQuote .TextFileConsecutiveDelimiter = True .TextFileTabDelimiter = False .TextFileSemicolonDelimiter = False .TextFileCommaDelimiter = False .TextFileSpaceDelimiter = False .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1) .TextFileTrailingMinusNumbers = True .Refresh BackgroundQuery:=False End With Next i Set temp_qt = Nothing CleanUpQT Else MsgBox "No File Selected" End If End Sub Sub CleanUpQT() Dim connCount As Long Dim i As Long connCount = ThisWorkbook.Connections.Count For i = 1 To connCount ThisWorkbook.Connections.Item(i).Delete Next i End Sub