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

Question

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

excelcsvms-accessvba

5

我拥有以下VBA代码，可以将许多文本文件导入Access表中。但是，在包含双引号的文本的.TXT文件的情况下存在问题，这会导致该记录的所有其他字段都带有空值。

我尝试在选择“产品”字段时放置一个替换函数，但双引号无法正常工作。对于其他字符可以正常工作，但是双引号不行...

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

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

SCHEMA.INI [Test_temp.csv] ColNameHeader=false Format=Delimited(;) Col1="product" Text Col2="price" Double CSV文本文件：test01.txt TV SAMSUNG 21" WIDESCREEN LED;170 TV PHILIPS 27" WIDESCREEN LED;200 HD SEAGATE 1TB 7200RPM;150

VBA Access代码:

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

- Ralph MacLand

3个回答

1

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

因此，我建议使用导入规范。您可以通过手动使用文本导入向导一次导入csv文件并将其保存为“产品导入规范”来创建导入规范。有关详细信息，请参见this answer中的第1条。

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

然后，您需要链接文本文件并从中导入数据：

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

Result:

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

在将自动编号字段添加为tbProduct的主键后：

TransferText: 0,6640625
INSERT: 8,023438

8秒并不是真的很慢。

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

- Andre

它能工作。但是代码太慢了。想象一下使用100万条记录时的情况。看看你建议的上面的代码。有没有更快的方法？为什么代码很慢？ - Ralph MacLand

@RalphMacLand：请看编辑。对于我来说，使用100万条记录，仅使用两个字段运行时间为4.5秒，加上一个自动编号主键字段后为8秒。 - Andre

@RalphMacLand：P.S. 你可以省略 FileCopy 直接链接 test*.txt 文件。这是导入规范比 schema.ini 更好的另一个优点。--- 除非文件在网络驱动器上，否则最好先将它们复制到本地磁盘。 - Andre

@Andrea451: 我同意你的观点！8秒并不是真的很慢。我会检查我的机器配置（内存、CPU、进程、硬盘、虚拟内存等等）。谢谢！ - Ralph MacLand

0

你所需要做的就是将双引号包裹在单引号中：

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

话虽如此，我觉得先将文件链接为表格，然后使用链接的表格作为数据源会更容易。

- Gustav

使用Andrea451的代码，无需使用Replace函数。该代码可以在不使用Replace（双引号）的情况下正常工作。谢谢！ - Ralph MacLand

网页内容由stack overflow 提供, 点击上面的

可以查看英文原文，
原文链接

- user4039065 · Accepted Answer

既然您正在将文件从test01.txt复制到temp_test.csv，为什么不趁机打开它并用Unicode「智能引号」字符（例如”）替换不需要的引号，以避免在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