Connection string passing all values as text

Question

I'm struggling with importing data into excel sheet from text file with header line

Values in the text file are separated with tab, therefore I had to create Schema.ini file, which is saved in the same folder as text file:

[test no1.txt]
ColNameHeader=True
Format=TabDelimited
MaxScanRows=0
Col1="Column number 1" Float
Col2="Column number 2" Text
Col3="Column number 3" Text

I'm selecting all values from text file into recordset. Then, I'm using this connection string to open target excel:

Public Function getXlsConn() As ADODB.Connection
    Dim rv As New ADODB.Connection
    Dim strConn As String

    strConn = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
    "Data Source=" & targetFileName & ";" & _
    "Extended Properties=""Excel 12.0;HDR=YES;IMEX=0"";"

    rv.Open strConn
    Set getXlsConn = rv
End Function

I get target recordset (range in excel sheet), I'm looping through all lines of source recordset (data from text file) and passing them into target recordset. At the end of loop I'm updating target recordset with command UpdateBatch:

Sub CopyToXls(pRecordSet As ADODB.Recordset, pSheetName As String)
    Dim con As ADODB.Connection, rs As ADODB.Recordset
    Dim i As Long
    Dim size As Integer
    Dim fieldsArray() As Variant
    Dim values() As Variant

    Set con = getXlsConn()

    Set rs = New ADODB.Recordset

    rs.CursorLocation = adUseServer
    'header starts from 2nd row
    rs.Open "select *  from [" & pSheetName & "$A2:C600000]", con, _
             adOpenDynamic, adLockOptimistic

    'get number of columns and their names
    size = rs.Fields.Count - 1
    ReDim values(size)
    ReDim fieldsArray(size)
    For i = 0 To size
        fieldsArray(i) = rs.Fields(i).Name
    Next i

    'get end of file
    If rs.EOF = False Then
        rs.MoveFirst
    End If

    'copy rows from source recordset (text file) to target recordset (excel sheet)
    Do Until pRecordSet.EOF = True
            For i = 0 To size
                    values(i) = pRecordSet.Fields(i).Value
            Next i
            rs.AddNew fieldsArray, values
        pRecordSet.MoveNext
        rs.MoveNext
    Loop

    rs.UpdateBatch

    rs.Close
    Set rs = Nothing
    Set con = Nothing

End Sub

Unfortunately, all values are passed as text, therefore SUM function (located in A1 cell) for first column is not working.

I've tried to change IMEX parameter of connection string - for values 1 and 2 I'm getting error "Cannot update. Database object is read-only".

I would like to pass values exactly as I defined them in Schema.ini file. Is this possible?

Answer 1

Here is a general method to connect to a Text document.

My example text file looks like this:

1,a,b
1,a,b
1,a,b
1,a,b

For simplicity I just made the delimiter a comma.

Here's the code I'm using. One special note, if you have a different delimiter you'll need to change the delimiter type. I've noted that section of the code.

Public Sub OutputToExcel()
    Dim mySheet     As Worksheet: Set mySheet = ThisWorkbook.Sheets("Sheet1")
    Dim FolderPath  As String: FolderPath = "C:\Users\Megatron\Desktop\"
    Dim SQL         As String: SQL = "SELECT CDbl(F1) as Field1, " & _
                                     "Cstr(F2) as Text1, CStr(F3) as Text2 " & _
                                     "FROM MyFile.txt"

    Dim myRs        As ADODB.Recordset: Set myRs = New ADODB.Recordset
    Dim conn        As ADODB.Connection: Set conn = New ADODB.Connection

    'Change the FMT=Delimited to FMT=TabDelimited,
    'or continue using the schema.ini which I prefer
    Dim connstr     As String: connstr = "Provider=Microsoft.Ace.OLEDB.12.0;" & _
                                         "Data Source=" & FolderPath & _
                                         ";Extended Properties='text;HDR=No;FMT=Delimited';"
    'Open a connection
    With conn
        .connectionstring = connstr
        .Open
    End With

    'Read the data
    myRs.Open SQL, conn, adOpenForwardOnly, adLockOptimistic

    'Output the data
    mySheet.Range("A1").CopyFromRecordset myRs

    'Clean Up
    If myRs.State = adStateOpen Then myRs.Close: Set myRs = Nothing
    If conn.State = adStateOpen Then conn.Close: Set conn = Nothing
End Sub