为什么此CSV文件的SQL查询的VBA代码间歇性工作?

为什么此CSV文件的SQL查询的VBA代码间歇性工作?

问题描述:

一个非常简单的查询函数,它在源CSV文件和SQL语句作为字符串(我也移调从VBA函数的数据)的路径,为什么此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文件 - AbbreviatedFull。以下SQL查询完美地适用于缩写文件,但在完整文件上返回#VALUE。

SELECT birthYear FROM [File] 

这绝对不是数据限制/大小问题,因为Full文件只包含1800行。我完全糊涂了,并会感谢任何想法/指针。

顺便说一句,如果我包裹起来的逻辑成子,而不是一个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 

我很困惑,并希望任何指针。

+0

它在哪里返回'#VALUE'?你的代码只分配一个数组,* RunQuery *给记录集行。 – Parfait

+0

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

+0

您是否在工作表中将它用作UDF?如果你尝试从Sub调用它,你会得到更多有用的错误消息。 –

我适应技术的使用Sub并设法得到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 
+0

非常感谢,约翰。你点击头部 - 输出Variant数组不喜欢空值。将适应你的解决方案,以取代这些记录。感谢帮助。 – insomniac

当我建议从一个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 
+0

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

该按钮点击事件处理程序通过调用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 

子程序是多少,你有它,但也有引起问题与分配给一个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