Access VBA Импорт текстовых файлов останавливается на полпути

Question

Я использую Access 2013. Я пытаюсь импортировать файл .txt в Access. Текстовый файл 700 МБ (19 ММ записей). Мой код фильтрует данные и назначает групповое значение («Inode»), чтобы хранить связанные записи вместе, поэтому я ввожу только примерно 600 тыс. Записей.

Вот фрагмент исходного текстового файла (вы можете видеть, что каждая группа данных Inode разделена пунктирной линией):

Я бы хотел, чтобы конечный результат выглядел так:

По какой-то причине программа ОСТАНАВЛИВАЕТСЯ на полпути, в ТО ЖЕ ВРЕМЯ (примерно 8 ММ). Я не могу определить, в чем проблема. Я не думаю, что это проблема размера, потому что у меня много места. Я пытался реализовать обработку ошибок, но безрезультатно. Код просто обходит его, и программа заканчивается (появляется сообщение msgbox "done"). Открытие текстового файла и просмотр записи, где он останавливается, не помогает. В этой записи нет ничего плохого. Это просто останавливается, и я сбит с толку.

Вот код:

Private Sub ImportTextFile()
On Error GoTo Err_LogError
Dim strFile As String, strLine As String
Dim lngFreeFile
Dim sInode_Num As String
Set db = CurrentDb()
DAO.DBEngine.SetOption dbMaxLocksPerFile, 1000000  <--- not sure if this helps
Set rs = db.OpenRecordset("tblImport")
strFile = "C:\Data\store_data.txt"

    lngFreeFile = FreeFile
    Open strFile For Input As #lngFreeFile
    Do Until EOF(lngFreeFile)
        Line Input #lngFreeFile, strLine

    If Left(LCase(Trim(strLine)), 9) = "inode_num" Then
        sInode_Num = Trim(strLine)
    End If    

    If InStr(LCase(strLine), "kmditemlastuseddate") > 0 Or _
       InStr(LCase(strLine), "kmditemusecount") > 0 Or _
       InStr(LCase(strLine), "kmditemuseddates") > 0 Or _
       InStr(LCase(strLine), "kmditemdateadded") > 0 Then

        rs.AddNew
        rs![Inode_Num] = sInode_Num
        rs![FieldValue] = Trim(strLine)
        rs.Update

        End If
    Loop

Exit_LogError:
    MsgBox "done."
    Close #lngFreeFile
    Set rst = Nothing
    Exit Sub

Err_LogError:
    strMsg = "Error: " & Err.Number & vbCrLf & Err.Description
    MsgBox strMsg, vbCritical, "LogError()"
    Resume Exit_LogError

End Sub

ПРИМЕЧАНИЕ. Я использовал мастер импорта SSMS и смог загрузить текстовый файл целиком (19 мм записей) всего за несколько минут. Но ключом к этому является получение этой группы Inode, чтобы я мог хранить связанные записи вместе. Если есть способ сделать это через мастера, я бы хотел знать.

Любая помощь будет принята с благодарностью. Спасибо!

Answer 1

Я думаю, что нашел решение ... исходя из наблюдения Эрика относительно ограничений "open strFile for Input". Я нашел некоторый код, который использует CreateObject ("Scripting.FileSystemObject"). Затем с помощью "obj.Readline" я могу читать каждую строку отдельно, в отличие от чтения всех 19-мм записей в одном наборе записей.

Новый код здесь:

Public Function ReadTextFile()
    On Error GoTo Err_LogError

    Dim objFSO As Object
    Dim objTextStream As Object
    Dim strTextLine As String
    Dim strInputFileName As String
    Set db = CurrentDb()
    Set rs = db.OpenRecordset("tblImport")
    strInputFileName = "C:\Data\store_data.txt"

    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objTextStream = objFSO.OpenTextFile(strInputFileName)

    Do While Not (objTextStream.AtEndOfStream)
        strTextLine = objTextStream.ReadLine

            If Left(LCase(Trim(strTextLine)), 9) = "inode_num" Then
                sInode_Num = Trim(strTextLine)
            End If
            '
            If InStr(LCase(strTextLine), "kmditemlastuseddate") > 0 Or _
               InStr(LCase(strTextLine), "kmditemusecount") > 0 Or _
               InStr(LCase(strTextLine), "kmditemuseddates") > 0 Or _
               InStr(LCase(strTextLine), "kmditemdateadded") > 0 Then
            '
            rs.AddNew
            rs![Inode_Num] = sInode_Num
            rs![FieldValue] = Trim(strTextLine)
            rs.Update

            End If

    Loop

    Exit_LogError:
        objTextStream.Close
        Set objFSO = Nothing
        Set objTextStream = Nothing
        MsgBox "done."
        Exit Function

    Err_LogError:
        strMsg = "Error: " & Err.Number & vbCrLf & Err.Description
        MsgBox strMsg, vbCritical, "LogError()"
        Resume Exit_LogError

    End Function