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
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.