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
