Question

我拥有以下VBA代码，将许多文本文件放到Access表中。但是对于包含带双引号的文本的.TXT文件的情况存在问题，因此会使用空值中断该记录的所有其他字段。

我尝试在选择“产品”字段时添加“替换”功能，但不适用于“双引号”。使用其他字符，但双引号（否）......

您推荐哪些调整？任何建议将不胜感激。

*注意：实际数据超过100万条记录......

SCHEMA.INI
[Test_temp.csv]
ColNameHeader =假
格式=（;）分隔
Col1 =“产品”文字
Col2 =“价格”双重

TEXT FILE CSV：test01.txt
电视三星21“WIDESCREEN LED; 170
电视飞利浦27“WIDESCREEN LED; 200
HD SEAGATE 1TB 7200RPM; 150

代码VBA访问：

Sub TableImport()

    Dim strSQL As String
    Dim db As DAO.Database

    Dim strFolder As String
    strFolder = CurrentProject.Path

    Set db = CurrentDb

    strSQL = "DELETE FROM tbTest"
    db.Execute strSQL, dbFailOnError

    Dim strFile As String
    strFile = Dir(strFolder & "\test*.txt", vbNormal)

    Do Until strFile = ""

        FileCopy strFolder & "\" & strFile, strFolder & "\Test_temp.csv"

        strSQL = ""

        strSQL = " INSERT INTO tbTEST(product,price)"
        strSQL = strSQL & " SELECT fncReplace(product),price"
        strSQL = strSQL & " FROM [Text;HDR=no;FMT=Delimited;DATABASE=" & strFolder & "].Test_temp.csv"

        db.Execute strSQL, dbFailOnError

        strFile = Dir

    Loop

    db.Close

End Sub


Public Function fncReplace(varStr As Variant) As String
    If IsNull(varStr) Then
        fncReplace = ""
    Else
        fncReplace = Replace(Trim(varStr), """", "''")
    End If
End Function

更新 - 有效 - 建议：Andre451

Sub TableImport()

    Dim strSQL As String
    Dim db As DAO.Database

    Dim strFolder As String
    strFolder = CurrentProject.Path

    Set db = CurrentDb

    strSQL = "DELETE FROM tbTest"
    db.Execute strSQL, dbFailOnError

    Dim strFile As String
    strFile = Dir(strFolder & "\test*.txt", vbNormal)

    Do Until strFile = ""

        FileCopy strFolder & "\" & strFile, strFolder & "\Test_temp.csv"

        DoCmd.TransferText acLinkDelim, "specIMPORTAR", "linkData", strFolder & "\Test_temp.csv", False

        strSQL = ""
        strSQL = " INSERT INTO tbTEST(product,price)"
        strSQL = strSQL & " SELECT product,price"
        strSQL = strSQL & " FROM linkData"

        db.Execute strSQL, dbFailOnError

        strFile = Dir

        DoCmd.DeleteObject acTable, "linkData"

    Loop

    db.Close

End Sub

Answer 1

由于您要将文件从test01.txt复制到temp_test.csv，为什么不借此机会将其打开并用Unicode'smart quote'字符（例如”）替换不需要的引号不会弄乱CSV读取？

Sub TableImport()

    Dim strSQL As String, f As Long, strm As String, ln as long
    Dim db As DAO.Database, rs As DAO.Recordset

    Dim strFolder As String
    strFolder = Environ("TEMP") 'CurrentProject.Path

    Set db = CurrentDb

    strSQL = "DELETE FROM tbTest"
    db.Execute strSQL, dbFailOnError

    Dim strFile As String
    strFile = Dir(strFolder & "\test*.txt", vbNormal)

    Do Until strFile = ""

        strm = vbNullString
        f = FreeFile
        Open strFolder & "\" & strFile For Binary Access Read As #f
        strm = Input$(LOF(f), f)
        Close #f
        strm = Replace(strm, Chr(34), ChrW(8221))   '<~~ replace double-quote character with Unicode right smart quote character
        'optionally strip off the first 5 lines
        for ln = 1 to 5
            strm = mid$(strm, instr(1, strm, chr(10)) + 1)
        next ln
        Kill strFolder & "\Test_temp.csv"
        f = FreeFile
        Open strFolder & "\Test_temp.csv" For Binary Access Write As #f
        Put #f, , strm
        Close #f

        strSQL = vbNullString
        strSQL = "INSERT INTO tbTEST(product,price)"
        strSQL = strSQL & " SELECT F1, F2"
        strSQL = strSQL & " FROM [Text;HDR=no;FMT=Delimited(;);DATABASE=" & strFolder & "].[Test_temp.csv]"

        db.Execute strSQL, dbFailOnError + dbSeeChanges

        strFile = Dir

    Loop

    db.Close

End Sub

Answer 2

读取csv文件时，双引号被解释为文本分隔符。在SCHEMA.INI中似乎没有办法明确告诉Access“没有文本分隔符！”。

所以我建议改用导入规范。您可以通过文本导入向导手动导入csv文件来创建导入规范，并保存它，例如作为“产品进口规格”。有关详细信息，请参阅this answer中的1.。

在规范中，将“none”设置为文本分隔符。在德语访问中：

然后链接文本文件并从中导入数据：

Public Sub ImportProducts()

    Dim S As String

    ' Link csv file as temp table
    DoCmd.TransferText acLinkDelim, "Product import specification", "linkData", "D:\temp\Test01.csv", False

    ' Insert from temp table into product table
    S = "INSERT INTO tbProduct (product, price) SELECT product, price FROM linkData"
    CurrentDb.Execute S

    ' Remove temp table
    DoCmd.DeleteObject acTable, "linkData"

End Sub

修改

我创建了一个包含1.000.000行（36 MB）的csv文件，并将其用作导入文件：

Const cFile = "G:\test.csv" Public Sub CreateCSV() Dim S As String Dim i As Long Open cFile For Output As #1 For i = 1 To 1000000 Print #1, "Testing string number " & CStr(i) & ";" & CStr(i) Next i Close #1 End Sub Public Sub ImportProducts() Dim S As String Dim snTime As Single snTime = Timer ' Clean up product table CurrentDb.Execute "DELETE * FROM tbProduct" Debug.Print "DELETE: " & Timer - snTime ' Link csv file as temp table DoCmd.TransferText acLinkDelim, "Product import specification", "linkData", cFile, False Debug.Print "TransferText: " & Timer - snTime ' Insert from temp table into product table S = "INSERT INTO tbProduct (product, price) SELECT product, price FROM linkData" CurrentDb.Execute S Debug.Print "INSERT: " & Timer - snTime ' Remove temp table DoCmd.DeleteObject acTable, "linkData" End Sub

<强>结果：

DELETE: 0 TransferText: 0,6640625 INSERT: 4,679688

将自动编号字段添加为tbProduct：
的主键后
TransferText: 0,6640625 INSERT: 8,023438

8秒并不是那么慢确保Access数据库和导入的CSV文件都在本地磁盘上，而不在网络驱动器上。如果可能，在SSD上。

Answer 3

您只需要在双引号中包装双引号：

Public Function fncReplace(varStr As Variant) As String
    fncReplace = Replace(Trim(Nz(varStr)), Chr(39), Chr(34) & Chr(39))
End Function

那就是说，我会发现首先将文件作为表链接起来更容易，然后使用链接表作为源。

在Access VBA中转义双引号 - INSERT INTO ... SELECT

3 个答案: