Asked by:
VBA ADO Cutting Decimals (Possible Bug?)

Question
-
Hi,
Problem:
I have the below code in a module which works perfectly usually, but when i run it on this sample file:
https://drive.google.com/open?id=0BygwXrk7-L67WW9xRnFFdm9nSlRYb2h2eE1lNWtTUjl0cWFF
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() 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
- 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 - I'm using:
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