PrintOut : Append Data To Text format

Question

I Have A Table Including 230 Records And I Need A Code To Print Out Per 20 Record In Seperated Text File 

Means First 20 Record In Text File Save To 1.Txt 

And Next 20 Record Save To Another Text File With 2.Txt And Go On And The Last Text File Will Be Save Just 10 Record From 221 Till 230

Docmd.printout Is good But If Do it You Never Can Import That To Table If Needed

THANKS 

PROFESSOR

Answer 1

How do you determine the sort order of the table? Before you can define what the groups of 20 records are you need to identify the order. Daniel's code depends on a SQL statement you pass to the function.

Answer 2

Thanks For Your Great Help Dear Engineer

Answer 3

You can do something like

Public Sub ExportRecordSetToTxt(sTxtPath As String, lMaxRecsPerTxt As Long, sSQL As String)

    On Error GoTo Error_Handler

    Dim db                    As DAO.Database

    Dim rs                    As DAO.Recordset

    Dim fld                   As DAO.Field

    Dim sTxtString            As String

    Const sDelim              As String = ","    'Delimiter to use to seperate filed data

    If Right(sTxtPath, 1) <> "" Then sTxtPath = sTxtPath & "" 'Make sure we have a trailing \ on the path

    Set db = CurrentDb

    Set rs = db.OpenRecordset(sSQL, dbOpenSnapshot)

    If rs.RecordCount <> 0 Then

        j = 1    'Initial file counter/name

        Do While Not rs.EOF

            i = i + 1    'Record Counter

            If i > lMaxRecsPerTxt Then

                i = 1    'Restart the record counter

                j = j + 1    'Text file counter/name

            End If

            sTxtString = "" 'Reinitialize the string for each record

            For Each fld In rs.Fields 'Loop through all the fields and build a string to append to the text file

                sTxtString = sTxtString & fld.Value & sDelim

            Next fld

            If Right(sTxtString, Len(sDelim)) = sDelim Then _

               sTxtString = Left(sTxtString, Len(sTxtString) - Len(sDelim))

            Call AppendTxt(sTxtPath & j & ".txt", sTxtString) 'Append the string to the text file

            rs.MoveNext

        Loop

    End If

Error_Handler_Exit:

    On Error Resume Next

    If Not fld Is Nothing Then Set fld = Nothing

    If Not rs Is Nothing Then

        rs.Close

        Set rs = Nothing

    End If

    If Not db Is Nothing Then Set db = Nothing

    Exit Sub

Error_Handler:

    MsgBox "The following error has occured" & vbCrLf & vbCrLf & _

           "Error Number: " & Err.Number & vbCrLf & _

           "Error Source: ExportRecordSetToTxt" & vbCrLf & _

           "Error Description: " & Err.Description & _

           Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _

           , vbOKOnly + vbCritical, "An Error has Occured!"

    Resume Error_Handler_Exit

End Sub

'---------------------------------------------------------------------------------------

' Procedure : AppendTxt

' DateTime  : 2007-Mar-06 10:14

' Author    : CARDA Consultants Inc.

' Website   : http://www.cardaconsultants.com

' Purpose   : Output Data to an external file (*.txt or other format)

'             ***Do not forget about access' DoCmd.OutputTo Method for

'             exporting objects (queries, report,...)***

'

' Input Variables:

' ~~~~~~~~~~~~~~~~

' sFile - name of the file that the text is to be output to including the full path

' sText - text to be output to the file

'---------------------------------------------------------------------------------------

Function AppendTxt(ByVal sFile As String, ByVal sText As String)

On Error GoTo Err_Handler

    Dim FileNumber As Integer

    FileNumber = FreeFile                   ' Get unused file number

    Open sFile For Append As #FileNumber    ' Connect to the file

    Print #FileNumber, sText                ' Append our string

    Close #FileNumber                       ' Close the file

Exit_Err_Handler:

    Exit Function

Err_Handler:

    MsgBox "The following error has occured" & vbCrLf & vbCrLf & _

           "Error Number: " & Err.Number & vbCrLf & _

           "Error Source: AppendTxt" & vbCrLf & _

           "Error Description: " & Err.Description, vbCritical, "An Error has Occured!"

    GoTo Exit_Err_Handler

End Function

and you'd call it by doing something like

Call ExportRecordSetToTxt("FullPathWhereYouWantToSaveTheTextFiles", 20, "YourTableName")

For Example

Call ExportRecordSetToTxt("C:\Users\GAli\Desktop\DbExports", 20, "tbl_Clients")

Answer 4

Thanks Sir But I Could Not Made A Loop Thu Recordset ... I Think My Problem Is Hard , 3 Days I M Working On This Subject Without Any Result ..... I Cannot Able To Draw Algorithm Then Do According To That

Answer 5

One option would be to loop through the recordset and use a function like http://www.devhut.net/2011/06/06/vba-append-text-to-a-text-file/ to append the data to a text file.