为什么此VBA代码用于CSV文件上的SQL查询会间歇性地工作？

Question

一个非常简单的查询函数，它以字符串形式获取源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文件的一个示例是“ 缩写”和“ 完整” 。 下面的SQL查询在缩写文件上可以完美地工作，但是在完整文件上返回#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

我很困惑，不胜感激。

Answer 1

当我建议从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

Answer 2

此按钮单击事件处理程序通过调用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值位于第二维。 我将它们分配给具有第一维值的数组，这样它将按行填充范围。

函数似乎不允许您将值分配给范围-无论如何，我找不到找到它的方法。

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

Answer 3

我对使用Sub的技术进行了调整，并设法获得了一个Function ，该Function返回缩写文件和完整文件的数组。

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

=RunQuery("C:\stackoverflow", "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