CODEWITHSUNDEEP
excelvba
mediaeval
mediaeval

Reputation: 143

Importing mixed data types using ADO

The routine below reads in a csv file using ADO. The csv file I am reading has 139,000 lines of data, with 136 columns. The routine is not working as intended. One of the columns has zero values for all rows except for 500 or so rows, where it takes a decimal value of, say, 0.05 or 0.03 etc. Because this method uses ADO, it determines the data type of the field using a setting in the registry, TypeGuessRows, where, based on a pre-specfied number of rows, it makes a guess at the data type of that column. So, for the column in the example, it is, I think, assuming an integer data type because the first couple of hundred values are all zero. The few values that are decimal and non-zero are then forced to fit the assumed data type and therefore also become zero. I cannot change the value of TypeGuessRows because, in the company I work for, I do not have permissions to change the registry. Of the 136 columns, there are many other columns with a similar problem.

Is there a way around this? I have seen a suggestion that I could use a dummy first row with the value that will imply the desired data type, but this is an overhead I would rather not incur.

Or do I simply need to use a method of data import that does not use ADO?

Sub GetDataTextFile1(strFilePath As String, strSheet As String, strRange As String, strField As String, strValue As String)

    Dim strFolder As String, strFile As String, strSQL As String
    Dim objConnection As ADODB.Connection
    Dim objRecordSet As ADODB.Recordset

    'If an error occurs then handle it
    'On Error GoTo ErrorTrap

    'Get the name of the file and the folder
    strFile = Right(strFilePath, Len(strFilePath) - InStrRev(strFilePath, "\"))
    strFolder = Left(strFilePath, Len(strFilePath) - Len(strFile) - 1)

    Set objConnection = New ADODB.Connection
    Set objRecordSet = New ADODB.Recordset

    'Open Connection
    objConnection.Open "Provider=Microsoft.ACE.OLEDB.12.0;" _
                        & "Data Source=" & strFolder & ";" _
                        & "Extended Properties=""text;HDR=YES;FMT=Delimited"""

    'Generate SQL code to extract data from the file
    If strField <> "" And strValue <> "" Then
        strSQL = "SELECT * FROM [" & strFile & "] WHERE CSTR([" & strField & "]) IN ('" & strValue & "');"
    Else
        strSQL = "SELECT * FROM [" & strFile & "];"
    End If

    'Execute the SQL code
    Set objRecordSet = objConnection.Execute(strSQL)

    'Copy the data in to the relevant range in the spreadsheet
    ThisWorkbook.Sheets(strSheet).Range(strRange).CopyFromRecordset objRecordSet

    'Close the recordset and the connection to the database
    objRecordSet.Close
    objConnection.Close

    Set objRecordSet = Nothing
    Set objConnection = Nothing

ExitPoint:
    Exit Sub

ErrorTrap:
    Call ErrorHandler(Err.Number, Err.Description, "GetDataTextFile1")

End Sub

Upvotes: 1

Views: 1407

Answers (2)

ASH
ASH

Reputation: 20302

You can import your CSV, and even multiple CSV files, using the script below.

Sub ReadFilesIntoActiveSheet()

    Dim fso As FileSystemObject
    Dim folder As folder
    Dim file As file
    Dim FileText As TextStream
    Dim i As Long
    Dim cl As Range

    Set fso = New FileSystemObject
    Set folder = fso.GetFolder("C:\Users\Excel\Desktop\test\")

    Set cl = ActiveSheet.Cells(1, 1)

    Application.ScreenUpdating = False

    For Each file In folder.Files

        Set FileText = file.OpenAsTextStream(ForReading)
        cl.Value = file.Name
        i = 1

        Do While Not FileText.AtEndOfStream
            cl.Offset(i, 0).Value = FileText.ReadLine
            i = i + 1
        Loop

        FileText.Close

        Set cl = cl.Offset(0, 1)
    Next file

    Application.ScreenUpdating = True

    Set FileText = Nothing
    Set file = Nothing
    Set folder = Nothing
    Set fso = Nothing

End Sub

Upvotes: 0

Harassed Dad
Harassed Dad

Reputation: 4704

Replace the line

 ThisWorkbook.Sheets(strSheet).Range(strRange).CopyFromRecordset objRecordSet

With the following

Dim r as range
Dim f as field
dim x as long
Set r = ThisWorkbook.Sheets(strSheet).Range(strRange)
Do while not objrecordset.eof
     x = 0
     For each f in objrecordset.fields
        r.offset(0,x) = objrecordset(x)
        x = x +1
    next f
    objrecordset.movenext
    set r = r.offset(1,0)
loop

This will bring the data in bit by bit. If that isn't sufficient to avoid it guessing the datatype you can add a select case f.name routine to force the datatype of certain fields

Upvotes: 1

Related Questions