Excel VBA ADO Сокращение десятичных дробей (возможная ошибка в ADO?) - PullRequest
Новая
       55

Excel VBA ADO Сокращение десятичных дробей (возможная ошибка в ADO?)

1 голос
/ 15 марта 2019

Кто-нибудь может мне помочь с этим, пожалуйста?

Проблема : У меня есть приведенный ниже код в модуле, который обычно работает отлично, но когда я запускаю его на этом примере файла , я заметил, что десятичные дроби в «Верхнем пределе» (столбец D) обрезаются.

Временное решение, которое я нашел , состояло в том, что мне пришлось изменить в файле примера верхний предел от 1 до 1,0 (чтобы добавить «.0» в конце) в строке 26, чтобы он выглядел как десятичное число. После этого десятичные дроби были правильно импортированы на листе. Но это не решение.

Я использую : Excel 2013 (15.0.5111.1000) 32-разрядный (офисный пакет: MS Office Standard 2013) и следующие библиотеки включены (screenshot of libraries)

Как воспроизвести :

  1. Поместите приведенный ниже код в модуль и запустите его на примере файла
  2. Обратите внимание на столбец D. Начиная со строки 6 все десятичные дроби обрезаются. Ты сможешь смотреть только целые числа.
  3. Теперь откройте файл примера (например, в Notepad ++) и измените верхнее предельное значение в строке 26 от «1» до «1,0», затем сохраните его. (screenshot of line 26)
  4. Еще раз запустите приведенный ниже код в измененном файле примера и столбец D (верхний предел), начиная со строки 6 все десятичные дроби появляются.

Есть идеи, почему это происходит? 

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 Ответ

0 голосов
/ 16 марта 2019

Спасибо всем, что это решило проблему.

Итак, оказалось, что решение состоит в том, чтобы создать файл "schema.ini" в той же папке, что и мой CSV-файл, который обрабатывается ADO.

Я создал INI-файл со следующими строками, и проблема исчезла.

[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
...