Excel ADO 强制数据类型

Question

我将数据存储在 excel 文件中，我正在尝试使用 VBA 对它们运行 SQL 查询。 问题是我正在使用的数据非常脏，不幸的是我对其内容的控制非常有限。因为那个 excel 已经吓坏了，并且不断地为列分配错误的数据类型。

我最好的猜测是类型是由表格第一行中的值决定的。但不幸的是，这种行为确实是不可预测的，而且并非总是如此。示例如下：

我有包含字符串和空值、零或错误的列。此列被视为双列而不是文本。因此，在执行CopyFromRecordset 后，此列中的每个非数字值都会被删除。 我也有带有数字和偶尔为空值的列，然后该列被视为文本。

它与带有WHERE 或JOIN 子句的SQL 查询相混淆。因为如果我在具有 double 类型的列上进行字符串比较，它将不起作用。如果我试图在字符串列上进行数字比较，如果它反过来发生也是一样的。

有时可以通过在有问题的列上设置适当的格式来避免问题，有时可以通过在第一行中写入其他内容来避免问题。但正如我所说，这真的是不可预测的，有时它不起作用。

尝试过这样的事情（遵循this type table）：

dbRecordset.Fields(2).Type = 200

但我得到Operation is not allowed when the object is open。

我也尝试在 SQL 查询中进行手动转换，但我觉得它慢得多，语法也很乱。例如这里断言类型为 double （它只有一列，我还有几十个）：

Cdbl(IIf(IsNull(c.[Column4]), 0, c.[Column4])) > 0

那么 - 有没有办法告诉 excel 每列中的数据类型是什么？或者如何避免我的问题？

这是我的代码：

Option Explicit

Sub RunCopy()
    Dim dbConnection  As Object
    Dim dbRecordset   As Object
    Dim strSQL        As String
    Dim dbField       As Variant
    Dim fieldCounter  As Long

    Dim src_wks As Worksheet
    Dim dst_wks As Worksheet

    Set src_wks = Worksheets("Src")
    Set dst_wks = Worksheets("Dst")

    Set dbConnection = CreateObject("ADODB.Connection")
    Set dbRecordset = CreateObject("ADODB.Recordset")

    ' CONNECTION WITH EXCEL ODBC DRIVER
    dbConnection.Open "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};" _
                          & "DBQ=" & ThisWorkbook.FullName & ";"

    ' OPEN RECORDSET
    dst_wks.UsedRange.Clear
    dbRecordset.Open "SELECT d.* FROM [Src$] d WHERE d.[Column4] > 0", dbConnection
    dbRecordset.Fields(2).Type = 200
    With dst_wks
        ' HEADERS
        fieldCounter = 0
        For Each dbField In dbRecordset.Fields
            fieldCounter = fieldCounter + 1
            .Cells(1, fieldCounter).Value = dbField.name
        Next dbField
        ' DATA ROWS
        .Range("A2").CopyFromRecordset dbRecordset
    End With
    dbRecordset.Close

    dbConnection.Close
    Set dbRecordset = Nothing: Set dbConnection = Nothing
End Sub

Answer 1

您可以在代码开头添加类似的内容吗？

Columns("A:E").Select
Selection.NumberFormat = "0"

这对你有用吗？

Answer 2

也许您使用另一个驱动程序来访问数据

    dbConnection.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & _
        ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=YES;IMEX=1"";"

来自connectionstrings

始终使用 IMEX=1 是检索混合数据的更安全的方法 列。考虑一个 Excel 文件可能工作正常的场景 导致该文件的数据导致驱动程序猜测一种数据类型，而 另一个文件，包含其他数据，导致驱动程序猜测 另一种数据类型。这可能会导致您的应用崩溃。

更新：我仍然不确定需要什么。我附上了使用in memory recordset 的代码。然后通过将数据复制到该记录集中来完成转换。如果 column4 包含非整数值，这可能会失败

Option Explicit

Sub RunCopy()
    Dim dbConnection  As Object
    Dim dbRecordset   As Object
    Dim strSQL        As String
    Dim dbField       As Variant
    Dim fieldCounter  As Long

    Dim src_wks As Worksheet
    Dim dst_wks As Worksheet

    Set src_wks = Worksheets("Src")
    Set dst_wks = Worksheets("Dst")

    Set dbConnection = CreateObject("ADODB.Connection")
    Set dbRecordset = CreateObject("ADODB.Recordset")

    ' Add a reference Microsoft ActiveXData Objects
    Dim rstInMem As ADODB.Recordset
    Set rstInMem = CreateObject("ADODB.Recordset")

    With rstInMem
        .Fields.Append "Column1", adVarChar, 20, adFldMayBeNull
        .Fields.Append "Column2", adVarChar, 20, adFldMayBeNull
        .Fields.Append "Column3", adVarChar, 20, adFldMayBeNull
        .Fields.Append "Column4", adInteger
        .CursorType = adOpenKeyset
        .CursorLocation = adUseClient
        .LockType = adLockPessimistic
        .Open
    End With


    ' CONNECTION WITH EXCEL ACE DRIVER
        dbConnection.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & _
    ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=YES;IMEX=1"";"


    ' OPEN RECORDSET
    dst_wks.UsedRange.Clear
    'dbRecordset.Open "SELECT d.* FROM [Src$] d WHERE d.[Column1] > 0", dbConnection

    dbRecordset.Open "SELECT * FROM [Src$]", dbConnection
    'dbRecordset.Fields(2).Type = 200

    Do Until dbRecordset.EOF
        rstInMem.AddNew
        rstInMem.Fields(0) = dbRecordset.Fields(0)
        rstInMem.Fields(1) = dbRecordset.Fields(1)
        rstInMem.Fields(2) = dbRecordset.Fields(2)
        ' this might fail if dbRecordset.Fields(3) is a string
        rstInMem.Fields(3) = dbRecordset.Fields(3)
        rstInMem.Update
        dbRecordset.movenext
    Loop


    With dst_wks
        ' HEADERS
        fieldCounter = 0

        For Each dbField In rstInMem.Fields
            fieldCounter = fieldCounter + 1
            .Cells(1, fieldCounter).Value = dbField.Name
        Next dbField

        rstInMem.MoveFirst
        rstInMem.Filter = rstInMem.Fields(3).Name & ">0"
        .Range("A2").CopyFromRecordset rstInMem 'dbRecordset
    End With
    dbRecordset.Close
    rstInMem.Close

    dbConnection.Close

End Sub