VBA ADO Cutting Decimals (Possible Bug?) RRS feed

  • Question

  • Hi,

    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:
      Visual Basic For Applications
      Microsoft Excel 15.0 Object Library
      OLE Automation
      Microsoft Office 15.0 Object Library
      Microsoft Access 14.0 Object Library
      Microsoft Office 15.0 Access database engine Object
      Windows Script Host Object Model
      Microsoft ActiveX Data Objects 2.8 Library
      Microsoft ActiveX Data Objects Recordset 2.8 Library

    So how to reproduce:
    1) Put the below code in a module and run it on the sample file
    2) Notice column D. Starting from line 6 all decimals are cut. You will see only integers.
    3) 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.
    4) 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.

    Can anybody help me with this please?

    Sub ADODB_Import_CSV()
        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
        End With
        Recordset.Close: Set Recordset = Nothing: Connection.Close: Set Connection = Nothing
    End Sub

    • Edited by Zsolt Turkosi Friday, March 15, 2019 1:23 PM
    • Moved by Bill_Stewart Wednesday, September 4, 2019 6:37 PM Off-topic
    Friday, March 15, 2019 1:18 PM

All replies

  • This is not an office VBA forum.  You need to post in the Office VBA forum for help with your issue.


    Friday, March 15, 2019 2:18 PM
  • You're right, i will post it there.

    Sorry for this.

    Friday, March 15, 2019 2:51 PM