ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   ADO Recordset to Text File (https://www.excelbanter.com/excel-programming/312123-ado-recordset-text-file.html)

Ctal

ADO Recordset to Text File
 
We are trying to return the results of a query as a text file. The
recordset returns too many rows to bring into a spreadsheet. The following
generates a runtime error with the message "Not enough storage to complete
this operation"

Set conn = New ADODB.Connection
connn.Open "driver={SQL
Server};server=chtsrvessb01;database=SRAdmin;uid=; pwd="

rs.CursorLocation = adUseClient
strSQL = Sheets("Ref").Range("B1").Value

Set rs = conn.Execute(strSQL)

#1 = Freefile
Open strLoc For Output as #1

Print #1, rs.GetString()
Close #1



RB Smissaert

ADO Recordset to Text File
 
You could use this code:
It uses the array function ArrayTranspose, which you can download from
Alan Beban's website:
http://home.pacbell.net/beban/

Function RecordSetToText(ByRef rs As ADODB.Recordset, _
ByVal txtFile As String, _
ByVal doFields As Boolean, _
Optional ByRef fldArray As Variant) As Boolean

'makes a comma delimited text file from an ADO recordset
'optionally puts the field names in the first row
'if the fldArray is supplied this will be used for the
'fields, if not it will be taken from the field names of
'the recordset
'returns true if successfull
'-------------------------------------------------------

Dim tempArray()
Dim LC As Byte
Dim LR As Long

On Error GoTo NORECORDS
tempArray = rs.GetRows

tempArray = ArrayTranspose(tempArray)

LC = UBound(tempArray, 2)
LR = UBound(tempArray, 1)

If doFields = True Then
If IsMissing(fldArray) Then
SaveArrayToText2 txtFile, _
tempArray, _
0, _
LR, _
0, _
LC, _
fieldArrayFromRS(rs)
Else
SaveArrayToText2 txtFile, _
tempArray, _
0, _
LR, _
0, _
LC, _
fldArray
End If
Else
SaveArrayToText2 txtFile, _
tempArray, _
0, _
LR, _
0, _
LC
End If

rs.Close
Set rs = Nothing

RecordSetToText = True

Exit Function

NORECORDS:

If Not rs Is Nothing Then
If rs.State = adStateOpen Then
rs.Close
End If
Set rs = Nothing
End If

RecordSetToText = False

End Function

Sub SaveArrayToText2(ByVal txtFile As String, _
ByRef arr As Variant, _
Optional ByVal LBRow As Long = -1, _
Optional ByVal UBRow As Long = -1, _
Optional ByVal LBCol As Long = -1, _
Optional ByVal UBCol As Long = -1, _
Optional ByRef fieldArr As Variant)

'this one organises the text file like
'a table by inserting the right line breaks
'------------------------------------------
Dim R As Long
Dim c As Long
Dim hFile As Long

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

If UBRow = -1 Then
UBRow = UBound(arr, 1)
End If

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

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

hFile = FreeFile

Open txtFile For Output As hFile

If IsMissing(fieldArr) Then
For R = LBRow To UBRow
For c = LBCol To UBCol
If c = UBCol Then
Write #hFile, arr(R, c)
Else
Write #hFile, arr(R, c);
End If
Next
Next
Else
For c = LBCol To UBCol
If c = UBCol Then
Write #hFile, fieldArr(c)
Else
Write #hFile, fieldArr(c);
End If
Next
For R = LBRow To UBRow
For c = LBCol To UBCol
If c = UBCol Then
Write #hFile, arr(R, c)
Else
Write #hFile, arr(R, c);
End If
Next
Next
End If

Close #hFile

End Sub


RBS


"Ctal" wrote in message
. com...
We are trying to return the results of a query as a text file. The
recordset returns too many rows to bring into a spreadsheet. The
following generates a runtime error with the message "Not enough storage
to complete this operation"

Set conn = New ADODB.Connection
connn.Open "driver={SQL
Server};server=chtsrvessb01;database=SRAdmin;uid=; pwd="

rs.CursorLocation = adUseClient
strSQL = Sheets("Ref").Range("B1").Value

Set rs = conn.Execute(strSQL)

#1 = Freefile
Open strLoc For Output as #1

Print #1, rs.GetString()
Close #1




Jamie Collins

ADO Recordset to Text File
 
"Ctal" wrote ...

We are trying to return the results of a query as a text file. The
recordset returns too many rows to bring into a spreadsheet. The following
generates a runtime error with the message "Not enough storage to complete
this operation"


So don't bring it into the spreadsheet <g.

Better to use the OLE DB provider for Jet to create the textfile.
Change the connection string e.g.

Const CONN_STRING As String = "" & _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=<<path to any closed Excel workbook;" & _
"Extended Properties='Excel 8.0'

connn.Open CONN_STRING

Then use Jet's SELECT..INTO syntax e.g.

SELECT MyDataCol
INTO [Text;HDR=Yes;DATABASE=C:\MyFolder\;].[MyOutFile#txt]
FROM [ODBC;Driver={SQL
Server};server=chtsrvessb01;database=SRAdmin;uid=; pwd=;].MyTable
;

Jamie.

--

MacroChaotic

ADO Recordset to Text File
 
How about using a DTS job from within SQL Server. That's what I do.

"Ctal" wrote:

We are trying to return the results of a query as a text file. The
recordset returns too many rows to bring into a spreadsheet. The following
generates a runtime error with the message "Not enough storage to complete
this operation"

Set conn = New ADODB.Connection
connn.Open "driver={SQL
Server};server=chtsrvessb01;database=SRAdmin;uid=; pwd="

rs.CursorLocation = adUseClient
strSQL = Sheets("Ref").Range("B1").Value

Set rs = conn.Execute(strSQL)

#1 = Freefile
Open strLoc For Output as #1

Print #1, rs.GetString()
Close #1





All times are GMT +1. The time now is 12:07 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com