FYI - Issue with TransferText in Access - VBA

[matchine]

This is a recommendation based on my research on an issue with the
transfer text functionality. The comments below were from a tech I
approched for help.

"The transfer text process blocked after importing 6139 records each
time on my side. After further research, there maybe a memory leak in
TransferText. When the number of records exceeds its limitation, the
transfer process blocked. Therefore, please abandon TransferText and
write own code to read text file line by line."

I was writing code to continually monitor a folder and import any text
files. Below is the recommended solution. Works much more quickly,
although the memory use still seems to reach extremely high levels when
left running for extended periods of time.

J
Private Sub ProcessFrame_Click()
'procedure to import all files in a directory and delete them.
'assumes they are all the correct format for an ASCII delimited import.

Dim ErrCounter
On Error GoTo Err_Errorclear

mfquit = False
Me![CurrentStatus] = "Processing..."
Me![ESCMessage] = "Press ESC to Halt Message Processing."

StartProcess:
Do While Me![ProcessFrame] = 1 And mfquit = False

'Allow keystokes to process
DoEvents

Dim strFldr As String
Dim strFile As String
Dim intInputData As Integer
Dim rst1 As ADODB.Recordset

Dim fl As Long
Set rst1 = New ADODB.Recordset
rst1.Open "tblRawBroadcastMessage", CurrentProject.Connection,
adOpenKeyset, adLockOptimistic

Dim MyChar As String
Dim MyString As String

strFldr = Me![ImportFolderDest]
strFile = Dir(strFldr)
intInputData = FreeFile()

If Len(strFile) > 0 Then
Open Me![ImportFolderDest] & strFile For Input As #intInputData
Do While Not EOF(intInputData) ' Loop until end of file.
rst1.AddNew
f1 = LOF(intInputData)

MyChar = Input(f1, #intInputData) ' Get one character.
rst1("Message") = MyChar
rst1.Update
Loop
'delete the file (consider moving it to an Archive folderinstead.)
Close #intInputData
FileCopy Me![ImportFolderDest] & strFile, Me![ProcessFolderDest] &
strFile
Kill Me![ImportFolderDest] & strFile

strFile = ""

rst1.Close
Set rst1 = Nothing
End If

'If there is more than one days worth of production in table on Monday,
export archive file and clear table (files older than 7 days)
If Weekday(Now) = 2 Then
If DCount("[DateCreated]", "tblRawBroadcastMessage",
"[DateCreated]<>null") > 37350 Then
mydate = Now
DoCmd.TransferText acExportFixed, "ExportTextSpec",
"qryExportText", "C:\BroadcastProcessing\SCE Messages\Archive\" &
Me![SystemName] & "-EBroadcastArchive-" & Format(mydate, "yyyymmdd") &
".txt", False, ""
DoCmd.SetWarnings False
DoCmd.OpenQuery "qryDeleteData"
DoCmd.SetWarnings True
End If
End If
Loop
Me![ProcessFrame] = 0
MsgBox "Process Cancelled. Messages will not be Imported.", vbCritical
Me![CurrentStatus] = "Process Cancelled!"
Me![ESCMessage] = ""
GoTo EndProcess

Err_Errorclear:
Err.Clear
Resume StartProcess
EndProcess:
End Sub