Тип данных Excel ADO force

Question

У меня есть данные, хранящиеся в файлах Excel, и я пытаюсь выполнить SQL запросов к ним с помощью VBA. Проблема в том, что данные, с которыми я работаю, довольно грязные, и, к сожалению, мой контроль над их содержимым очень ограничен. Из-за этого Excel сходит с ума и постоянно присваивает столбцам неверный тип данных.

Лучше всего я предполагал, что тип определяется значением в первой строке таблицы. Но, к сожалению, поведение действительно непредсказуемо, и это не всегда так. Вот пример:

У меня есть столбцы со строками и пустыми значениями, нулями или ошибками. Эти столбцы обрабатываются как двойной вместо текста. И из-за этого каждое не числовое значение в этом столбце стирается после выполнения CopyFromRecordset. У меня также есть столбцы с числами и случайными пустыми значениями, а затем столбец обрабатывается как текст.

Он связывается с запросами SQL с предложениями WHERE или JOIN. Потому что, если я сделаю сравнение строк в столбце с типом double, это не сработает. То же самое, если это происходит в обратном порядке, если я пытаюсь сравнить числа в строковом столбце.

Иногда проблемы можно избежать, задав правильное форматирование для проблемных c столбцов, иногда записав что-то еще в первой строке , Но, как я уже сказал, это действительно непредсказуемо, а иногда и не работает.

Пробовал что-то вроде этого (после таблица типов ):

dbRecordset.Fields(2).Type = 200

Но я получаю Operation is not allowed when the object is open.

Я также пытался выполнить ручное преобразование внутри запроса SQL, но мне кажется, что он намного медленнее, а синтаксис действительно грязный. Например, здесь утверждается тип double (и это только один столбец, у меня есть еще пара десятков):

Cdbl(IIf(IsNull(c.[Column4]), 0, c.[Column4])) > 0

Итак, есть ли способ сообщить Excel, какой тип данных находится внутри каждого столбца? ИЛИ как избежать моих проблем?

Вот мой код:

Option Explicit

Sub RunCopy()
    Dim dbConnection  As Object
    Dim dbRecordset   As Object
    Dim strSQL        As String
    Dim dbField       As Variant
    Dim fieldCounter  As Long

    Dim src_wks As Worksheet
    Dim dst_wks As Worksheet

    Set src_wks = Worksheets("Src")
    Set dst_wks = Worksheets("Dst")

    Set dbConnection = CreateObject("ADODB.Connection")
    Set dbRecordset = CreateObject("ADODB.Recordset")

    ' CONNECTION WITH EXCEL ODBC DRIVER
    dbConnection.Open "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};" _
                          & "DBQ=" & ThisWorkbook.FullName & ";"

    ' OPEN RECORDSET
    dst_wks.UsedRange.Clear
    dbRecordset.Open "SELECT d.* FROM [Src$] d WHERE d.[Column4] > 0", dbConnection
    dbRecordset.Fields(2).Type = 200
    With dst_wks
        ' HEADERS
        fieldCounter = 0
        For Each dbField In dbRecordset.Fields
            fieldCounter = fieldCounter + 1
            .Cells(1, fieldCounter).Value = dbField.name
        Next dbField
        ' DATA ROWS
        .Range("A2").CopyFromRecordset dbRecordset
    End With
    dbRecordset.Close

    dbConnection.Close
    Set dbRecordset = Nothing: Set dbConnection = Nothing
End Sub

Answer 1

Возможно, вы используете другой драйвер для доступа к данным

    dbConnection.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & _
        ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=YES;IMEX=1"";"

Из строки подключения

Всегда использовать IMEX = 1 - более безопасный способ получения данные для смешанных столбцов данных. Рассмотрим сценарий, согласно которому один файл Excel может работать нормально, потому что данные файла заставляют драйвер угадывать один тип данных, в то время как другой файл, содержащий другие данные, заставляет драйвер угадывать другой тип данных. Это может привести к тому, что ваше приложение взломает sh.

Обновление: Я все еще не уверен, что нужно. Я приложил код, который использует в наборе записей памяти . Затем преобразование выполняется путем копирования данных в этот набор записей. Это может завершиться ошибкой, если column4 содержит нецелые значения

Option Explicit

Sub RunCopy()
    Dim dbConnection  As Object
    Dim dbRecordset   As Object
    Dim strSQL        As String
    Dim dbField       As Variant
    Dim fieldCounter  As Long

    Dim src_wks As Worksheet
    Dim dst_wks As Worksheet

    Set src_wks = Worksheets("Src")
    Set dst_wks = Worksheets("Dst")

    Set dbConnection = CreateObject("ADODB.Connection")
    Set dbRecordset = CreateObject("ADODB.Recordset")

    ' Add a reference Microsoft ActiveXData Objects
    Dim rstInMem As ADODB.Recordset
    Set rstInMem = CreateObject("ADODB.Recordset")

    With rstInMem
        .Fields.Append "Column1", adVarChar, 20, adFldMayBeNull
        .Fields.Append "Column2", adVarChar, 20, adFldMayBeNull
        .Fields.Append "Column3", adVarChar, 20, adFldMayBeNull
        .Fields.Append "Column4", adInteger
        .CursorType = adOpenKeyset
        .CursorLocation = adUseClient
        .LockType = adLockPessimistic
        .Open
    End With


    ' CONNECTION WITH EXCEL ACE DRIVER
        dbConnection.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & _
    ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=YES;IMEX=1"";"


    ' OPEN RECORDSET
    dst_wks.UsedRange.Clear
    'dbRecordset.Open "SELECT d.* FROM [Src$] d WHERE d.[Column1] > 0", dbConnection

    dbRecordset.Open "SELECT * FROM [Src$]", dbConnection
    'dbRecordset.Fields(2).Type = 200

    Do Until dbRecordset.EOF
        rstInMem.AddNew
        rstInMem.Fields(0) = dbRecordset.Fields(0)
        rstInMem.Fields(1) = dbRecordset.Fields(1)
        rstInMem.Fields(2) = dbRecordset.Fields(2)
        ' this might fail if dbRecordset.Fields(3) is a string
        rstInMem.Fields(3) = dbRecordset.Fields(3)
        rstInMem.Update
        dbRecordset.movenext
    Loop


    With dst_wks
        ' HEADERS
        fieldCounter = 0

        For Each dbField In rstInMem.Fields
            fieldCounter = fieldCounter + 1
            .Cells(1, fieldCounter).Value = dbField.Name
        Next dbField

        rstInMem.MoveFirst
        rstInMem.Filter = rstInMem.Fields(3).Name & ">0"
        .Range("A2").CopyFromRecordset rstInMem 'dbRecordset
    End With
    dbRecordset.Close
    rstInMem.Close

    dbConnection.Close

End Sub

Answer 2

Можете ли вы добавить что-то подобное в начало кода?

Columns("A:E").Select
Selection.NumberFormat = "0"

Это работает для вас?