CODEWITHSUNDEEP
vbams-access
Craig
Craig

Reputation: 155

Access VBA Import Text File Stops Halfway

I'm using Access 2013. I'm trying to import a .txt file into Access. The text file is 700MB (19MM records). My code filters the data and assigns a group value ("Inode") to keep associated records together - so I'm only bringing in roughly 600K records.

Here is a snippet of the source text file (you can see each Inode data group is separated by a dashed line):

enter image description here

I would like the final result to look like this:

enter image description here

For some reason, the program STOPS halfway through, at the SAME RECORD (roughly 8MM record mark). I can't locate what the issue is. I don't think it's a size issue as I have plenty of space. I've tried implementing error handling, but to no avail. The code simply bypasses it and the program ends (msgbox "done" appears). Opening the text file and reviewing the record where it stops does not help. There is nothing wrong/different about that record. It simply stops and I am baffled.

Here is the code:

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

NOTE: I used SSMS import wizard and was able to ingest the text file in its' entirety (19MM records) in just a few minutes. But the key to this is getting that Inode grouping so I can keep the associated records together. If there is a way to do that through the wizard i'd like to know.

Any assistance would be greatly appreciated. Thank you!

Upvotes: 0

Views: 175

Answers (1)

Craig
Craig

Reputation: 155

I think I found the solution..working from Erik's observation regarding "open strFile for Input" limitations. I found some code that uses CreateObject("Scripting.FileSystemObject"). Then with "obj.Readline" I can read each line separately, as opposed to reading the entire 19MM records into one recordset.

The new code is here:

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

Upvotes: 1

Related Questions