【问题标题】:Access VBA Import Text File Stops HalfwayAccess VBA 导入文本文件中途停止
【发布时间】:2018-11-08 07:44:17
【问题描述】:

我正在使用 Access 2013。我正在尝试将 .txt 文件导入 Access。文本文件为 700MB(19MM 记录)。我的代码过滤数据并分配一个组值(“Inode”)以将关联的记录保存在一起 - 所以我只引入了大约 600K 记录。

这里是源文本文件的sn-p(可以看到每个inode数据组用虚线隔开):

我希望最终结果如下所示:

由于某种原因,程序在中途停止,在 SAME RECORD(大约 8MM 记录标记)处。我找不到问题所在。我认为这不是尺寸问题,因为我有足够的空间。我试过实现错误处理,但无济于事。代码只是绕过它,程序结束(出现 msgbox“完成”)。打开文本文件并查看它停止的记录没有帮助。该记录没有任何错误/不同。它只是停止了,我很困惑。

代码如下:

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 分组,这样我就可以将关联的记录放在一起。如果有办法通过向导做到这一点,我想知道。

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

【问题讨论】:

  • 您的文本文件包含多少个字符? Open strFile For Input As #lngFreeFile 将文件限制为 2^31 个字符 iirc,您可能需要使用 WinAPI 才能处理更大的文件
  • @Erik:谢谢……嗯……嗯,不确定。但我想象的远不止 2^31。不知道如何将 WINAPI 与 Access VBA 一起使用 - 我会仔细阅读这个网站。有可用的链接吗?
  • 不要认为有使用 VBA 使用 WinAPI 访问文件的链接,这是一个小众主题。我有一些代码来自尝试进行异步文件写入,您可能可以重新利用这些代码,但我认为我最好在您确认这是问题后写一个完整的答案。您可以在阅读时保留一个计数器,我 99% 确定您在阅读 2^31 个字符后会达到 EOF。这个docs page 描述了声明外部 DLL,但这些是 C++ api,映射类型可能很困难
  • 哦,如果您使用的是 64 位还是 32 位 Access,请告诉我。如果您可以访问LongLong 数据类型,那么编写处理大文件/对象的代码通常会容易得多。
  • 请分享您的解决方案作为答案,而不是对问题的编辑

标签: vba ms-access


【解决方案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

【讨论】:

    猜你喜欢
    • 2021-12-19
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 2021-05-01
    • 1970-01-01
    • 2020-12-23
    • 2016-11-25
    • 2014-09-19
    相关资源
    最近更新 更多