为啥这个用于 CSV 文件上的 SQL 查询的 VBA 代码会间歇性地工作？

Posted 2023-03-23

【中文标题】为啥这个用于 CSV 文件上的 SQL 查询的 VBA 代码会间歇性地工作？

【英文标题】：Why does this VBA code for SQL queries on CSV files work intermittently?为什么这个用于 CSV 文件上的 SQL 查询的 VBA 代码会间歇性地工作？

【发布时间】：2016-10-29 18:37:53

【问题描述】：

一个非常简单的查询函数，它接受源 CSV 文件的路径和作为字符串的 SQL 语句（我也在转置来自 VBA 函数的数据），

Public Function RunQuery(FilePath As String, SQLStatement As String)

    Dim Conn As New ADODB.Connection
    Dim RecSet As New ADODB.Recordset

    With Conn
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .ConnectionString = "Data Source=" & FilePath & ";" & _
        "Extended Properties=""text;HDR=Yes;FMT=Delimited;IMEX=1"""
    End With

    Conn.Open
    RecSet.Open SQLStatement, Conn
    RecSet.MoveFirst
    RunQuery = RecSet.GetRows()

    Conn.Close
    Set RecSet = Nothing
    Set Conn = Nothing

End Function

此代码对 CSV 文件间歇性地工作，有些数据可以正确检索，有些则不能。

例如这两个 CSV 文件 - Abbreviated 和 Full。以下 SQL 查询在 Abbreviated 文件上完美运行，但在 Full 文件上返回 #VALUE。

SELECT birthYear FROM [File]

这绝对不是数据限制/大小问题，因为完整文件仅包含 1800 行。我完全糊涂了，如果有任何想法/指针，我将不胜感激。

顺便说一句，如果我将逻辑包装到 Sub 而不是 UDF 中，那么它可以完美运行而不会出现任何错误，

Public Sub RunQuerySub()

Dim Conn As New ADODB.Connection
Dim RecSet As New ADODB.Recordset
Dim FilePath As String
FilePath = ActiveSheet.Range("Path")

With Conn
    .Provider = "Microsoft.Jet.OLEDB.4.0"
    .ConnectionString = "Data Source=" & FilePath & ";" & _
    "Extended Properties=""text;HDR=Yes;FMT=Delimited;IMEX=1"""
End With
Dim SQLStatement As String
SQLStatement = ActiveSheet.Range("SQL")

Conn.Open
RecSet.Open SQLStatement, Conn
ActiveSheet.Cells(1, 8).CopyFromRecordset RecSet

Conn.Close
Set RecSet = Nothing
Set Conn = Nothing

End Sub

我很困惑，不胜感激。

【问题讨论】：

它在哪里返回#VALUE？您的代码仅将数组 RunQuery 分配给记录集行。

如果我在Set Conn = Nothing 的最后一行设置了一个断点，那么RunQuery 会在Watch 窗口中显示一个Variant 数组，其中包含完整的结果列表。但由于某种原因，它会将#VALUE 返回到工作表本身。如前所述，此问题仅发生在较大的文件上，而不是较小的文件。

您是否将其用作工作表中的 UDF？如果您尝试从 Sub 调用它，您将收到更有用的错误消息。

好吧，现在我完全糊涂了。在大文件上运行与 Sub 相同的查询。将其作为 UDF 运行会引发 #VALUE。

当定义为一个函数时，你是如何把它放到 excel 页面上的？我猜 Excel 只是不支持通过函数将变量数组传递到页面

【参考方案1】：

我调整了使用Sub 的技术，并设法获得了一个Function，它返回一个包含缩略文件和完整文件的数组。

突出显示一列中的 1892 个单元格并使用此数组函数

=RunQuery("C:\***", "SELECT birthYear FROM [full.csv]")

这就是函数。它将结果集中的Null 值替换为零。

Public Function RunQuery(FilePath As String, SQLStatement As String)

    Dim Conn As New ADODB.Connection
    Dim RecSet As New ADODB.Recordset
    Dim rows As Variant
    On Error GoTo ErrHandler
    With Conn
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .ConnectionString = "Data Source=" & FilePath & ";" & _
        "Extended Properties=""text;HDR=Yes;FMT=Delimited;IMEX=1"""
    End With

    Conn.Open
    RecSet.Open SQLStatement, Conn
    RecSet.MoveFirst
    rows = RecSet.GetRows()

    Conn.Close
    Set RecSet = Nothing
    Set Conn = Nothing

    Dim nrows As Integer, i As Integer, valu As Integer
    nrows = UBound(rows, 2) + 1
    ReDim arr2(1 To nrows, 1 To 1) As Integer
    For i = 1 To nrows
        If IsNull(rows(0, i - 1)) Then
            valu = 0
        Else
            valu = rows(0, i - 1)
        End If
        arr2(i, 1) = valu
    Next
    RunQuery = arr2
    Exit Function

ErrHandler:
    Debug.Print Err.Number, Err.Description
    Resume Next
End Function

【讨论】：

非常感谢，约翰。你一针见血——输出的 Variant 数组不喜欢空值。将调整您替换这些记录的解决方案。感谢您的帮助。

【参考方案2】：

当我建议从 Sub 运行它时，我并不是真的作为 Sub。

我的意思是像下面这样，你的函数没有改变，唯一的区别是你是从 VBA 而不是作为 UDF 运行它。

从 VBA 运行时，您将能够看到任何错误，而不仅仅是在工作表单元格中获取 #VALUE。

Sub Tester()
    Dim arr
    arr = RunQuery("yourPath", "yourSQL")
End sub


Public Function RunQuery(FilePath As String, SQLStatement As String)

    Dim Conn As New ADODB.Connection
    Dim RecSet As New ADODB.Recordset

    With Conn
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .ConnectionString = "Data Source=" & FilePath & ";" & _
        "Extended Properties=""text;HDR=Yes;FMT=Delimited;IMEX=1"""
    End With

    Conn.Open
    RecSet.Open SQLStatement, Conn
    RecSet.MoveFirst
    RunQuery = RecSet.GetRows()

    Conn.Close
    Set RecSet = Nothing
    Set Conn = Nothing

End Function

【讨论】：

谢谢。看起来问题是 VBA 不喜欢查询返回的结果中某些列中包含的 NULL 值。

【参考方案3】：

此按钮单击事件处理程序通过调用RunQuerySub 产生结果。在 B2、B3 中定义了三个输入参数。 B4。

Sub Button1_Click()
    Dim FilePath As String, SQLStatement As String, TargetColumn As String
    FilePath = Sheet1.Range("B2").Text
    SQLStatement = Sheet1.Range("B3").Text
    TargetColumn = Sheet1.Range("B4").Text
    Call RunQuerySub(FilePath, SQLStatement, TargetColumn)
End Sub

子例程和你的一样，但是有一些 Null 值会导致分配给 Range 对象时出现问题，所以我用零替换了这些值。 RecSet.GetRows() 的结果集是一个 2D 变体数组，其birthYear 值位于第 2 维。我将它们分配给具有第一个维度中的值的数组，因此它将逐行填充范围。

函数似乎不允许您为范围分配值 - 无论如何我找不到这样做的方法。

Public Sub RunQuerySub(FilePath As String, SQLStatement As String, TargetColumn As String)

    Dim Conn As New ADODB.Connection
    Dim RecSet As New ADODB.Recordset
    Dim rows As Variant
    On Error GoTo ErrHandler
    With Conn
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .ConnectionString = "Data Source=" & FilePath & ";" & _
        "Extended Properties=""text;HDR=Yes;FMT=Delimited;IMEX=1"""
    End With

    Conn.Open
    RecSet.Open SQLStatement, Conn
    RecSet.MoveFirst
    rows = RecSet.GetRows()

    Conn.Close
    Set RecSet = Nothing
    Set Conn = Nothing

    Dim dest As Range
    Dim nrows As Integer, i As Integer, valu As Integer
    nrows = UBound(rows, 2) + 1
    ReDim arr2(1 To nrows, 1 To 1) As Integer
    For i = 1 To nrows
        If IsNull(rows(0, i - 1)) Then
            valu = 0
        Else
            valu = rows(0, i - 1)
        End If
        arr2(i, 1) = valu
    Next
    Dim rangeDefn As String
    rangeDefn = TargetColumn & "1:" & TargetColumn & CStr(nrows)
    With ThisWorkbook.Sheets("Sheet1")
        Set dest = .Range(rangeDefn)
    End With
    dest = arr2
    Exit Sub

ErrHandler:
    Debug.Print Err.Number, Err.Description
    Resume Next
End Sub