Excel VBA ADO Cutting Decimals (Possible Bug in ADO?)

问题

Can anybody help me with this please?

The problem: I have the below code in a module which works perfectly usually, but when i run it on this sample file, I noticed that the decimals in the "Upper Limit" (column D) are cut.

A temporary solution i found was that i had to modify in the sample file the upper limit from 1 to 1.0 (so to add ".0" at the end) at line 26 to make it look like a decimal number. After this the decimals were imported correctly on the sheet. But, this is not a solution.

I'm using: Excel 2013 (15.0.5111.1000) 32-bit (office package is: MS Office Standard 2013) and the following libraries enabled

How to reproduce:

Put the below code in a module and run it on the sample file
Notice column D. Starting from line 6 all decimals are cut. You will see only integers.
Now, open the sample file (in Notepad++ for example), and modify the upper limit value in line 26 from "1" to "1.0", then save it.
Run the below code again on the modified sample file and notice in column D (Upper Limit) that starting from line 6 all decimals appear.

Any idea why this happens?

Sub ADODB_Import_CSV()

ThisWorkbook.Sheets(1).Activate
ThisWorkbook.Sheets(1).Cells.Clear

Dim Connection As New ADODB.Connection
Dim Recordset As New ADODB.Recordset

On Error Resume Next
ChDrive ThisWorkbook.Path
ChDir ThisWorkbook.Path
On Error GoTo 0

ImportedFileFullPath = Application.GetOpenFilename
If ImportedFileFullPath = False Then Exit Sub
ImportedFileDirPath = Mid(ImportedFileFullPath, 1, InStrRev(ImportedFileFullPath, "\"))
ImportedFileName = Mid(ImportedFileFullPath, InStrRev(ImportedFileFullPath, "\") + 1, Len(ImportedFileFullPath))

Provider = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ImportedFileDirPath & ";Extended Properties=""text;HDR=Yes;FMT=Delimited"""
strSQL = "SELECT Trim(TestCodeDescription)," & _
                    "Cdbl(NumbericMeasure) AS Measurements," & _
                    "Cdbl(LowerLimit) AS LowerLimit," & _
                    "Cdbl(UpperLimit) AS UpperLimit" & _
             " " & _
             "FROM [" & ImportedFileName & "]" & _
             " " & _
             "WHERE (IsNumeric(LowerLimit) AND IsNumeric(UpperLimit) AND IsNumeric(NumbericMeasure) AND LowerLimit<>UpperLimit AND IsDate(EventDateTime1))"

Connection.Open Provider
Recordset.Open strSQL, Connection

For i = 0 To Recordset.Fields.Count - 1
    Cells(1, i + 1).Value = Recordset.Fields(i).Name
Next i

With ActiveSheet
    .Range("A2").CopyFromRecordset Recordset
    .Range("A1").AutoFilter
    .Columns.AutoFit
End With
Recordset.Close: Set Recordset = Nothing: Connection.Close: Set Connection = Nothing

End Sub

回答1:

Thanks everybody this solved the problem.

So it turned out that the solution is to create a "schema.ini" file in the same folder as my CSV file which is processed by ADO.

I created the ini file with the following lines and the issue is now gone.

[sample file for analysis.csv]
Format=CSVDelimited
Col1=SerialNumberCustomer Text
Col2=EventDateTime1 DateTime
Col3=EquipmentName Text
Col4=TestCodeDescription Text
Col5=NumbericMeasure Double
Col6=LowerLimit Double
Col7=UpperLimit Double

回答2:

I had the same problem. SQL delivered decimals but recordset returned values with no decimals.

Solution: In my SQL I used CAST(fieldname as Double) and then it worked fine. Data types like Decimal(15,6), Float DID NOT WORK. A bit frustration before I found this.

来源：https://stackoverflow.com/questions/55184134/excel-vba-ado-cutting-decimals-possible-bug-in-ado

标签

sql

excel

vba

ado

adodb