If you mean text files, I've pasted some code at the end of this message
that I've used in the past; modify it as required.
I am attempting to use Access to prepare datafiles for use with my testing
tools. I have a query that returns 221 rows. For testing purposes, I need
to break this query into files that contain 30 items each, plus whatever is
left over in the last file. The data changes slightly every week (adds,
deletes, modifications), and I would like to be able to have something I can
run that will generate the files automatically after the changes have been
entered. I'm fairly new to Access, but I have searched the examples and the
Help files and I can't seem to find anything that tells me how to do this.
Help, please?
'-------------START OF CODE---------------------------------
Sub ExportChunks(Source As String, _
FolderPath As String, BaseName As String)
Dim dbD As DAO.Database
Dim rsR As DAO.Recordset
Dim fldF As DAO.Field
Dim lngFN As Long
Dim j As Long
Dim lngChunk As Long
Dim lngChunkCount As Long
Dim strTarget As String
Dim strLine As String
Const MAX_CHUNK = 50000 'up to this many records can be
'exported as a single file
Const STD_CHUNK = 50000 'If more than MAX_CHUNK records,
'use this number of records per file
Const DELIM = vbTab 'tab-delimited; change as required
' argument checking and error trapping omitted
'Get ready
Set dbD = CurrentDb()
Set rsR = dbD.OpenRecordset(Source, dbOpenForwardOnly)
rsR.MoveLast 'ensure we get full record count
If rsR.RecordCount = 0 Then
MsgBox "No records to export", vbOKOnly + vbInformation
Exit Sub
ElseIf rsR.RecordCount <= MAX_CHUNK Then
lngChunk = MAX_CHUNK
Else
lngChunk = STD_CHUNK
End If
rsR.MoveFirst
lngChunkCount = 0
Do Until rsR.EOF 'Outer loop: once per file
'Open output file
j = 0
lngChunkCount = lngChunkCount + 1
strTarget = FolderPath & "\" & BaseName _
& Format(lngChunkCount, "00") & ".txt"
lngFN = FreeFile()
Open strTarget For Output As #lngFN
Do Until (j = lngChunk) Or rsR.EOF
'inner loop: once per record
'assemble fields into string
strLine = ""
For Each fldF In rsR.Fields
strLine = strLine & CStr(Nz(fldF.Value, "")) _
& DELIM
Next
Print #lngFN, strLine
j = j + 1
Loop 'inner
Close #lngFN
Loop 'outer
rsR.Close
Set rsR = Nothing
Set dbD = Nothing
End Sub
'--------------------------END OF CODE---------------------
This assumes tab-delimited output files. If you need CSV, change DELIM
to a comma and change the For...Next construct to something like this to
put quotes round the fields that need them because they contain a comma:
For Each fldF In rsR.Fields
If InStr(FldF.Value, DELIM) Then
strField = Chr(34) & fldF.Value & Chr(34)
Else
strField = fldF.Value
End If
strLine = strLine & CStr(Nz(fldF.Value, "")) _
& DELIM
Next
