I have a macro which calls the Sub below 17,000+ times to get data from an
equal number of small files. The macro always starts out running very
fast, but quickly slows to a snail's pace. The only way I have found to
speed it up again is to stop the macro, save the file and close Excel, then
restart Excel, reload the worksheet and have it pick up where it left off.

Clearly some resource is being used up and not released between calls to
the Sub. Perhaps I endup with a myriad of open files??

Any help in resolving this issue would be much appreciated. Thanks.

Here is the Sub:

Sub GetParcelInfoFromFile(Parcel As String)
Dim FileName As String
Dim qt As QueryTable

On Error GoTo NoQT 'Try to speed this up by deleting quries
For Each qt In Worksheets("Temp").QueryTables
qt.Delete
Next qt

NoQT:
On Error GoTo 0
'Build name of file containing data
FileName = "F:\IOW Harvest Data\" & Left(Parcel, 1) & "\" & Parcel &
".txt"

If Len(Dir(FileName)) = 0 Then 'If file does not exist
Range("Temp!A1") = "No File"
Exit Sub
End If
Worksheets("Temp").Select 'Get data into this sheet
With Worksheets("Temp").QueryTables.Add(Connection:="TE XT;" & FileName,
Destination:=Range("A1"))
.Name = Parcel
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = xlWindows
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1)
.Refresh BackgroundQuery:=False
End With
Worksheets(Orig).Select
End Sub