Почему этот код 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 и Full. Следующий SQL-запрос отлично работает в сокращенном файле, но возвращает #VALUE в полном файле.

SELECT birthYear FROM [File] 

Это определенно не проблема ограничения объема данных, так как полный файл содержит только 1800 строк. Я полностью одурачен и буду признателен за любые мысли/указатели.

Кстати, если я завернуть логику в Суб, а не ОДС, то он отлично работает без каких-либо ошибок,

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 и удалось получить 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 

Answer 2

Когда я предложил запустить его из Sub, я действительно не имел в виду как a 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 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 

подпрограмма много, как у вас, но есть некоторые Нулевые значения, вызвавшие проблемы с назначением на объект 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