Split records into txt files having the same number of records

72 Views Asked by At

I need your help today! In an Access database, the first column of table XY is to be written to several txt files using VBA code. The txt files should contain at least 500 data records. If there is a remainder, this should be distributed evenly across the txt files. Example: There are 1.729 data records in table XY Result: file 576 data records file 576 data records file 577 data records

I haven't found anything in the www. ChatGPT did not understand me so I need your help.

ChatGPT: This version puts the remainder in the last txt file ...

Sub ExportToTxtFiles_5()
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim totalRecords As Long
    Dim recordsPerFile As Long
    Dim numFiles As Integer
    Dim i As Integer
    Dim j As Integer
    Dim fileNum As Integer
    Dim filePath As String
    
    ' Set the path where you want to save the text files
    filePath = "C:\Temp\"

    ' Open the database and recordset
    Set db = CurrentDb()
    Set rs = db.OpenRecordset("SELECT Field FROM tableXY")
    rs.MoveLast
    ' Get the total number of records in the table
    totalRecords = rs.recordCount
    
    ' Calculate the number of files needed and the number of records per file
    numFiles = Int(totalRecords / 500) ' Number of files with 500 records
    recordsPerFile = Int(totalRecords / numFiles) ' Records per file
    rs.MoveFirst
    ' Loop through each file
    For i = 1 To numFiles
        ' Open a new text file
        fileNum = FreeFile
        Open filePath & "File_" & i & ".txt" For Output As fileNum
        
        ' Write records to the text file
        For j = 1 To recordsPerFile
            If Not rs.EOF Then
                Print #fileNum, rs.Fields(0) ' Assuming the first column is what you want to export
                rs.MoveNext
            End If
        Next j
        
        ' Close the text file
        Close fileNum
    Next i
    
    ' If there are remaining records, create another file for them
    If Not rs.EOF Then
        fileNum = FreeFile
        Open filePath & "File_" & numFiles & ".txt" For Append As fileNum
        
        ' Write remaining records to the text file
        Do Until rs.EOF
            Print #fileNum, rs.Fields(0) ' Assuming the first column is what you want to export
            rs.MoveNext
        Loop
        
        ' Close the text file
        Close fileNum
    End If
    
    ' Close the recordset and database
    rs.Close
    Set rs = Nothing
    Set db = Nothing
    
    MsgBox "Export completed successfully.", vbInformation
End Sub

2

There are 2 best solutions below

0
Storax On BEST ANSWER

My suggestion would be to calculate the number of files and records before exporting the data

    Option Compare Database
    Option Explicit
    
    Const RecordPerFile = 500   'Number of records on the miniumn per file
    
    Type recordDistibution
        NumberOfRecords As Long
        totalnumberOfFiles As Long
        addOneRecordNumberofFiles As Long
    End Type
    
    Function getDistribution(totalNumberOfRecords As Long) As recordDistibution
    ' This function will calculate the total number of files needed
    ' the number of files where one needs to add one extra record
    ' and the number of records per file
        
        Dim result As recordDistibution
        result.totalnumberOfFiles = Int(totalNumberOfRecords / RecordPerFile)
        
        Dim remaining As Long
        remaining = totalNumberOfRecords Mod RecordPerFile
        
        Dim additionalRecords As Long
        additionalRecords = Int(remaining / result.totalnumberOfFiles)
        
        result.NumberOfRecords = additionalRecords + RecordPerFile
        ' addOneRecordNumberofFiles  will always less than totalnumberOfFiles
        result.addOneRecordNumberofFiles = remaining Mod result.totalnumberOfFiles
        
        getDistribution = result
    
    End Function


Sub ExportToTxtFiles_5()
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim totalRecords As Long
    Dim recordsPerFile As Long
    Dim numFiles As Integer
    Dim i As Integer
    Dim j As Integer
    Dim fileNum As Integer
    Dim filePath As String
    
    ' Set the path where you want to save the text files
    filePath = "D:\Tmp\SO\"

    ' Open the database and recordset
    Set db = CurrentDb()
    Set rs = db.OpenRecordset("SELECT Artikel FROM tblData1")
    rs.MoveLast
    ' Get the total number of records in the table
    totalRecords = rs.RecordCount
    rs.MoveFirst
    
    Dim distInfo As recordDistibution
    distInfo = getDistribution(totalRecords)
    recordsPerFile = distInfo.NumberOfRecords + 1
    For i = 1 To distInfo.addOneRecordNumberofFiles
        fileNum = FreeFile
        Open filePath & "File_" & i & ".txt" For Output As fileNum
        For j = 1 To recordsPerFile
            If Not rs.EOF Then
                Print #fileNum, rs.Fields(0) ' Assuming the first column is what you want to export
                rs.MoveNext
            End If
        Next j

        Close fileNum
    Next i
    
    recordsPerFile = distInfo.NumberOfRecords
    For i = distInfo.addOneRecordNumberofFiles + 1 To distInfo.totalnumberOfFiles
        fileNum = FreeFile
        Open filePath & "File_" & i & ".txt" For Output As fileNum
        For j = 1 To recordsPerFile
            If Not rs.EOF Then
                Print #fileNum, rs.Fields(0) ' Assuming the first column is what you want to export
                rs.MoveNext
            End If
        Next j

        Close fileNum

    Next i

End Sub

Assumption is that Const RecordPerFile = 500 less than total number of records.

0
Olivier Jacot-Descombes On

You can distribute the remainder of the division equally among the files if you re-calculate the number of records per file for each file:

numFiles = totalRecords \ 500 ' Number of files with 500 records
rs.MoveFirst
' Loop through each file
For i = 1 To numFiles
    ' Open a new text file
    fileNum = FreeFile
    Open filePath & "File_" & i & ".txt" For Output As fileNum

    ' Write records to the text file
    recordsPerFile = totalRecords \ (numFiles - i + 1) ' Records per file
    totalRecords = totalRecords - recordsPerFile
    For j = 1 To recordsPerFile
        If Not rs.EOF Then
            Print #fileNum, rs.Fields(0) ' Assuming the first column is what you want to export
            rs.MoveNext
        End If
    Next j

    ' Close the text file
    Close fileNum
Next i

As you can see, recordsPerFile is calculated inside the For-loop. The variable totalRecords is updated at each loop to represent the remaining number of records. This number is divided by the remaining number of files numFiles - i + 1.

The backslash \ is the operator for the integer division.