I'm using Execl 2000 and am trying to write a macro that will write query
results to a text file rather than return the results to an excel
spreadhseet. Anyone know how to do this? Any help would be greatly
appreciated! Here is the code I have now that returns the query results to a
spreadsheet

Sub refresh_plc()
sql = "select max(day) from dataroom_plc_data "
DoQuery ("D4")
End Sub

-----------

Sub DoQuery(dest As String)
'Create new query

Range(dest).Select
rindex = Selection.Row
cindex = Selection.Column
Dim connstr As String
Dim rs As ADODB.Recordset
Dim cmd As ADODB.Command
Dim cn As ADODB.Connection
connstr = "User ID=me;Password=pwd;Data Source=database;Provider=MSDAORA.1"
Set cn = New ADODB.Connection
Set rs = New ADODB.Recordset
cn.Open (connstr)
rs.Open sql, cn
Cells(rindex, cindex).CopyFromRecordset rs
End Sub

You can get an array from a recordset by doing:

Dim arr

arr = rs.GetRows

Then with a Sub like this you can write that array to a text file.
You could also avoid the array and write directly from the recordset, but I
think it is a bit faster with the array. There also is the option to bypass
the
recordset and write directly to a text file with a text driver and using
INTO.

Sub SaveArrayToText(ByVal strFile As String, _
ByRef arr As Variant, _
Optional ByVal LB As Long = -1, _
Optional ByVal UB As Long = -1, _
Optional ByVal LB2 As Long = -1, _
Optional ByVal UB2 As Long = -1, _
Optional ByRef fieldArr As Variant, _
Optional bTranspose As Boolean)

Dim r As Long
Dim c As Long
Dim hFile As Long
Dim str As String

If LB = -1 Then
LB = LBound(arr, 1)
End If

If UB = -1 Or UB UBound(arr) Then
UB = UBound(arr, 1)
End If

If LB2 = -1 Then
LB2 = LBound(arr, 2)
End If

If UB2 = -1 Or UB2 UBound(arr, 2) Then
UB2 = UBound(arr, 2)
End If

hFile = FreeFile

Open strFile For Output As hFile

If bTranspose Then
If IsMissing(fieldArr) Then
For r = LB2 To UB2
For c = LB To UB
If c = UB Then
Write #hFile, arr(c, r)
Else
Write #hFile, arr(c, r);
End If
Next
Next
Else
For c = LB To UB
If c = UB Then
Write #hFile, fieldArr(c)
Else
Write #hFile, fieldArr(c);
End If
Next
For r = LB2 To UB2
For c = LB To UB
If c = UB Then
Write #hFile, arr(c, r)
Else
Write #hFile, arr(c, r);
End If
Next
Next
End If
Else
If IsMissing(fieldArr) Then
For r = LB To UB
For c = LB2 To UB2
If c = UB2 Then
Write #hFile, arr(r, c)
Else
Write #hFile, arr(r, c);
End If
Next
Next
Else
For c = LB2 To UB2
If c = UB2 Then
Write #hFile, fieldArr(c)
Else
Write #hFile, fieldArr(c);
End If
Next
For r = LB To UB
For c = LB2 To UB2
If c = UB2 Then
Write #hFile, arr(r, c)
Else
Write #hFile, arr(r, c);
End If
Next
Next
End If
End If

Close #hFile

End Sub


RBS


"GCF" wrote in message
...
I'm using Execl 2000 and am trying to write a macro that will write query
results to a text file rather than return the results to an excel
spreadhseet. Anyone know how to do this? Any help would be greatly
appreciated! Here is the code I have now that returns the query results to
a
spreadsheet

Sub refresh_plc()
sql = "select max(day) from dataroom_plc_data "
DoQuery ("D4")
End Sub

-----------

Sub DoQuery(dest As String)
'Create new query

Range(dest).Select
rindex = Selection.Row
cindex = Selection.Column
Dim connstr As String
Dim rs As ADODB.Recordset
Dim cmd As ADODB.Command
Dim cn As ADODB.Connection
connstr = "User ID=me;Password=pwd;Data
Source=database;Provider=MSDAORA.1"
Set cn = New ADODB.Connection
Set rs = New ADODB.Recordset
cn.Open (connstr)
rs.Open sql, cn
Cells(rindex, cindex).CopyFromRecordset rs
End Sub

That worked, Thanks!

"RB Smissaert" wrote:

You can get an array from a recordset by doing:

Dim arr

arr = rs.GetRows

Then with a Sub like this you can write that array to a text file.
You could also avoid the array and write directly from the recordset, but I
think it is a bit faster with the array. There also is the option to bypass
the
recordset and write directly to a text file with a text driver and using
INTO.

Sub SaveArrayToText(ByVal strFile As String, _
ByRef arr As Variant, _
Optional ByVal LB As Long = -1, _
Optional ByVal UB As Long = -1, _
Optional ByVal LB2 As Long = -1, _
Optional ByVal UB2 As Long = -1, _
Optional ByRef fieldArr As Variant, _
Optional bTranspose As Boolean)

Dim r As Long
Dim c As Long
Dim hFile As Long
Dim str As String

If LB = -1 Then
LB = LBound(arr, 1)
End If

If UB = -1 Or UB UBound(arr) Then
UB = UBound(arr, 1)
End If

If LB2 = -1 Then
LB2 = LBound(arr, 2)
End If

If UB2 = -1 Or UB2 UBound(arr, 2) Then
UB2 = UBound(arr, 2)
End If

hFile = FreeFile

Open strFile For Output As hFile

If bTranspose Then
If IsMissing(fieldArr) Then
For r = LB2 To UB2
For c = LB To UB
If c = UB Then
Write #hFile, arr(c, r)
Else
Write #hFile, arr(c, r);
End If
Next
Next
Else
For c = LB To UB
If c = UB Then
Write #hFile, fieldArr(c)
Else
Write #hFile, fieldArr(c);
End If
Next
For r = LB2 To UB2
For c = LB To UB
If c = UB Then
Write #hFile, arr(c, r)
Else
Write #hFile, arr(c, r);
End If
Next
Next
End If
Else
If IsMissing(fieldArr) Then
For r = LB To UB
For c = LB2 To UB2
If c = UB2 Then
Write #hFile, arr(r, c)
Else
Write #hFile, arr(r, c);
End If
Next
Next
Else
For c = LB2 To UB2
If c = UB2 Then
Write #hFile, fieldArr(c)
Else
Write #hFile, fieldArr(c);
End If
Next
For r = LB To UB
For c = LB2 To UB2
If c = UB2 Then
Write #hFile, arr(r, c)
Else
Write #hFile, arr(r, c);
End If
Next
Next
End If
End If

Close #hFile

End Sub


RBS


"GCF" wrote in message
...
I'm using Execl 2000 and am trying to write a macro that will write query
results to a text file rather than return the results to an excel
spreadhseet. Anyone know how to do this? Any help would be greatly
appreciated! Here is the code I have now that returns the query results to
a
spreadsheet

Sub refresh_plc()
sql = "select max(day) from dataroom_plc_data "
DoQuery ("D4")
End Sub

-----------

Sub DoQuery(dest As String)
'Create new query

Range(dest).Select
rindex = Selection.Row
cindex = Selection.Column
Dim connstr As String
Dim rs As ADODB.Recordset
Dim cmd As ADODB.Command
Dim cn As ADODB.Connection
connstr = "User ID=me;Password=pwd;Data
Source=database;Provider=MSDAORA.1"
Set cn = New ADODB.Connection
Set rs = New ADODB.Recordset
cn.Open (connstr)
rs.Open sql, cn
Cells(rindex, cindex).CopyFromRecordset rs
End Sub