vba - Access VBA 导入文本文件中途停止
问题描述
我正在使用 Access 2013。我正在尝试将 .txt 文件导入 Access。文本文件为 700MB(19MM 记录)。我的代码过滤数据并分配一个组值(“Inode”)以将关联的记录保存在一起——所以我只引入了大约 600K 记录。
这是源文本文件的片段(您可以看到每个 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 分组,这样我就可以将关联的记录放在一起。如果有办法通过向导做到这一点,我想知道。
任何帮助将不胜感激。谢谢!
解决方案
我想我找到了解决方案..从 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
推荐阅读
- python - 如何更改熊猫日期框列
- javascript - How to close CSS menu when clicking on links with JS?
- c++ - Qt 语言学家、宏和预处理器
- python - 如何创建一个从 1 开始的 ID,在排序后每次开始另一个(字符串,时间)变量增加 1(分钟)?
- wordpress - 如何修复 OG 标签 facebook?
- c# - 使用 BlobFromImage 时 EmguCV 访问冲突异常
- flutter - Flutter秒表后台运行
- php - 重定向 url 与 htaccess 完全匹配,如区分大小写
- python - 使用单个正则表达式在 python 中搜索 2 个条件
- reactjs - 我认为渲染工作两次