为什么这个 VBA 代码 SQL 查询 CSV 文件间歇性工作？

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 文件 - Abbreviated and Full。以下 SQL 查询在缩写文件上完美运行，但 returns #VALUE 在完整文件上运行。

SELECT birthYear FROM [File]

绝对不是数据 limit/size 问题，因为完整文件仅包含 1800 行。我完全糊涂了，我会很感激任何 thoughts/pointers.

顺便说一句，如果我将逻辑包装到一个 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() 的结果集是一个二维变体数组，其中 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，其中 returns 是一个用于缩写文件和完整文件的数组。

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

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

为什么这个 VBA 代码 SQL 查询 CSV 文件间歇性工作？

Why does this VBA code for SQL queries on CSV files work intermittently?

sql

csv

excel

vba

ado