SQL in VBA on text file

[RamziSaab]

Is it possible to do a qurey on a text file i found a code that will output the data, now i just want to do the query but i can seem to get a where function to work (the text file is tab delimited)...

Sub TestGetTextFileData()
GetTextFileData "SELECT * FROM test.txt" & " WHERE field1=" & "1" & ")", "c:\test", Range("A3")
End Sub

Sub GetTextFileData(strSQL As String, strFolder As String, rngTargetCell As Range)
Dim cn As ADODB.Connection, rs As ADODB.Recordset, f As Integer
If rngTargetCell Is Nothing Then Exit Sub
Set cn = New ADODB.Connection
On Error Resume Next
cn.Open "Driver={Microsoft Text Driver (*.txt; *.csv)};" & _
"Dbq=" & strFolder & ";" & _
"Extensions=csv,tab,txt;"
On Error GoTo 0
If cn.State <> adStateOpen Then Exit Sub
Set rs = New ADODB.Recordset
On Error Resume Next
rs.Open strSQL, cn, adOpenForwardOnly, adLockReadOnly, adCmdText
On Error GoTo 0
If rs.State <> adStateOpen Then
cn.Close
Set cn = Nothing
Exit Sub
End If


For f = 0 To rs.Fields.Count - 1
rngTargetCell.Offset(0, f).Formula = rs.Fields(f).Name
Next f
rngTargetCell.Offset(1, 0).CopyFromRecordset rs
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub

 

[PHV]

Why a closing paren in your WHERE clause ?

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886

 

[RamziSaab]

oversight sorry, but still does not work...is it possible do a quere on a text file?

 

[Remou]

I found that the file had to have a CSV extension for this to work.

Sub TestGetTextFileData()
    GetTextFileData "SELECT * FROM test.csv  WHERE field1=1", "C:\test", Range("A3")
End Sub

Sub GetTextFileData(strSQL As String, strFolder As String, rngTargetCell As Range)
Dim cn As ADODB.Connection, rs As ADODB.Recordset, f As Integer
    If rngTargetCell Is Nothing Then Exit Sub
    Set cn = New ADODB.Connection
    'On Error Resume Next
    cn.Open "Driver={Microsoft Text Driver (*.txt; *.csv)};" & _
        "Dbq=" & strFolder & ";" & _
        "Extensions=csv,tab,txt;"
    'On Error GoTo 0
    If cn.State <> adStateOpen Then Exit Sub
    Set rs = New ADODB.Recordset
    'On Error Resume Next
    rs.Open strSQL, cn, adOpenForwardOnly, adLockReadOnly, adCmdText
    'On Error GoTo 0
    If rs.State <> adStateOpen Then
        cn.Close
        Set cn = Nothing
        Exit Sub
    End If


    For f = 0 To rs.Fields.Count - 1
        rngTargetCell.Offset(0, f).Formula = rs.Fields(f).Name
    Next f
    rngTargetCell.Offset(1, 0).CopyFromRecordset rs
    rs.Close
    Set rs = Nothing
    cn.Close
    Set cn = Nothing
End Sub

 

[Remou]

Oops, I had to save with a CSV extension, to ensure that the tabs were saved properly, once saved, I could rename the file to .txt and the whole thing worked. Could it be that you are getting a "too few parameters, expected 1 error"? If so, you may have a similar problem in that the field names have been corrupted.

 

[RamziSaab]

my problem is the text file is huge (ie. more rows than excel can handle...so i dont think it will work for me

 

[RonRepp]

Ramzi:

Try this (it is for a CSV file, but can easily be converted to text/tab delimited.

==============================
For No Header:

Set Con = New ADODB.Connection
Set RS = New ADODB.Recordset

Con.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
    "Data Source=Y:\DebtNegotiationsCSV\;Extended Properties=""text;HDR=No;FMT=Delimited"""

Con.Open Con.ConnectionString
Sql = "Select * from " & txtStation.Text & ".csv"

Retry:
With RS
    .Open Sql, Con, adOpenDynamic, adLockBatchOptimistic
    .Filter = "F1='" & txtZip.Text & "'"
Do While Not .EOF
    MsgBox "ZIP: " & RS(0).Value & vbCrLf & "City: " & RS(1).Value
    .MoveNext
Loop
End With
==============================
With a header use this:

Set Con = New ADODB.Connection
Set RS = New ADODB.Recordset

Con.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
    "Data Source=Y:\DebtNegotiationsCSV\;Extended Properties=""text;HDR=Yes;FMT=Delimited"""

Con.Open Con.ConnectionString
Sql = "Select * from " & txtStation.Text & ".csv"

Retry:
With RS
    .Open Sql, Con, adOpenDynamic, adLockBatchOptimistic
    .Filter = .Fields(0).Name & "='" & txtZip.Text & "'"
Do While Not .EOF
    MsgBox "ZIP: " & RS(0).Value & vbCrLf & "City: " & RS(1).Value
    .MoveNext
Loop
End With
==============================

I hope this helps.


Ron Repp

If gray hair is a sign of wisdom, then I'm a genius.