Question

我正在使用Access2013。我正在尝试将.txt文件导入Access。文本文件为700MB（19MM记录）。我的代码过滤了数据并分配了一个组值（“ Inode”）以将相关记录保持在一起-因此，我只带进了大约60万条记录。

以下是源文本文件的摘要（您可以看到每个Inode数据组都由虚线分隔）：

我希望最终结果看起来像这样：

由于某种原因，程序在SAME RECORD（大约8MM记录标记）处中途停止。我找不到问题所在。我认为这不是大小问题，因为我有足够的空间。我尝试实现错误处理，但无济于事。该代码只是绕过它而程序结束（出现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导入向导，并且能够在短短几分钟内完全提取文本文件（19MM记录）。但是关键是要对Inode进行分组，这样我才能将相关记录保持在一起。如果有一种方法可以通过向导进行操作，那么我想知道。

任何帮助将不胜感激。谢谢！

Answer 1

我想我从Erik关于“打开输入的strFile”限制的观察中找到了解决方案。我找到了一些使用CreateObject（“ Scripting.FileSystemObject”）的代码。然后使用“ obj.Readline”可以分别读取每一行，而不是将整个19MM记录读取到一个记录集中。

新代码在这里：

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

Access VBA导入文本文件中途停止

1 个答案: