copy recordset to CSV file



Hi, I have the following code below which happily breaks down a CSV
into different worksheets in excel. However, what I want the VBA code
to do is copy the recordset to new CSV files, my code already creates
the new CSV files, but how do I send the data to the csv file and not
the worksheet? Thanks


Option Explicit

Sub ImportLargeFile()
Dim strFilePath As String, strFilename As String, strFullPath As
Dim oFile As TextStream
Dim lngCounter As Long
Dim oConn As Object, oRS As Object, oFSObj As Object
Dim xFile As Integer
Dim xFileName As String
Dim fso As FileSystemObject
Set fso = New FileSystemObject
Dim xStr As String
xFile = 1
xFileName = "C:\Users\Steve\Desktop\New folder\output"
'Get a text file name
strFullPath = "C:\Users\Steve\Desktop\New folder\test.csv"

'This gives us a full path name e.g. C:tempfolderfile.txt
'We need to split this into path and file name

strFilePath = oFSObj.GetFile(strFullPath).ParentFolder.Path
strFilename = oFSObj.GetFile(strFullPath).Name
Debug.Print (strFilePath)
Debug.Print (strFilename)

'Open an ADO connection to the folder specified
Set oConn = CreateObject("ADODB.CONNECTION")
oConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & strFilePath & ";" & _
"Extended Properties=""text;HDR=Yes;FMT=Delimited"""

Set oRS = CreateObject("ADODB.RECORDSET")

'Now actually open the text file and import into Excel
oRS.Open "SELECT * FROM " & strFilename, oConn, 3, 1, 1
While Not oRS.EOF
xFileName = "C:\Users\Steve\Desktop\New folder\output" & xFile
& ".csv"
Set oFile = fso.CreateTextFile(xFileName, True)
Worksheets(xFile).Range("A1").CopyFromRecordset oRS, 10000
xFile = xFile + 1


Application.ScreenUpdating = True

End Sub




Here's a reusable procedure you can use to send each record to a file
as requested.

Sub WriteTextFileContents(Text As String, FileName As String, Optional
AppendMode As Boolean = False)
' A reuseable procedure to write or append large amounts of data to a
text file

Dim iNum As Integer, bIsOpen As Boolean

On Error GoTo ErrHandler
iNum = FreeFile()
If AppendMode Then Open FileName For Append As #iNum Else Open
FileName For Output As #iNum
'If we got here the file has opened successfully
bIsOpen = True

'Print to the file in one single step
Print #iNum, Text

'Close the file
If bIsOpen Then Close #iNum
If Err Then Err.Raise Err.Number, , Err.Description
End Sub 'WriteTextFileContents()

Watch for word wraps of single lines.

This is a very fast, self-contained procedure so you don't have to
include its code in other procs. Example:

<air code>
In your current proc:
Const sPath As String = "C:\Users\Steve\Desktop\New folder\output"
While Not oRS.EOF
xFilename = sPath & xFile & ".csv"
WriteTextFileContents oRS, xFilename
xFile = xFile + 1

If you want to parse the recordset into subsets first, do that and pass
the entire subset for the first arg. So, for example, to parse the
recordset into subsets of 10,000 you'd have to dump the data into an
array or string var delimited by vbCrLf. I think it would be faster to
load the data into a string var<IMO>.

<air code>
Dim i As Integer, sSubSet As String
Const sPath As String = "C:\Users\Steve\Desktop\New folder\output"
Const iMaxRows As Integer = 10000
While Not oRS.EOF
xFilename = sPath & xFile & ".csv"
For i = 1 To iMaxRows
sSubSet = sSubSet & oRS & vbCrLf: oRS.MoveNext
WriteTextFileContents sSubSet, xFilename
xFile = xFile + 1


Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question