Try this please
Code:
Public Function StartReport01() As Integer
'
'--------------------------------------------------------------------------
Dim iCount As Integer, iCountEnd As Integer
Dim sNoFormat As String
Dim sReportName As String
Dim sReportText As String
Dim sReportPath As String
On Error GoTo StartReport_Err
iCountEnd = 20000 ' = Total reports
sNoFormat = "00000"
'sReportName = "prova" ' this is a simple report with only one fix text
sReportName = "rptTest"
'sReportPath = "C:\log.txt"
sReportPath = "D:\Temp\Temp001.txt"
If Dir(sReportPath, vbNormal) <> "" Then Kill sReportPath 'If file already present
Open sReportPath For Append As #1 ' this is a log file
For iCount = 1 To iCountEnd
Application.DoCmd.OpenReport sReportName, acNormal
Print #1, Format(iCount, sNoFormat); " - "; sReportName
Next iCount
MsgBox "Done!", vbInformation, "Printing Report " & sReportName
StartReport_End:
On Error Resume Next
Close #1
Exit Function
StartReport_Err:
MsgBox "Error: " & Err.Number & vbCrLf & Err.Description & vbCrLf & _
"in Function: StartReport in module: 00ModuleForTests", vbCritical, "Error in Application"
Err.Clear
Resume StartReport_End
End Function
or ...
Code:
Public Function StartReport02()
'IMHO Faster way
'--------------------------------------------------------------------------
Dim iCount As Integer, iCountEnd As Integer
Dim sNoFormat As String
Dim sReportName As String
Dim sReportText As String
Dim sReportPath As String
Dim iMet100%, x%, iMetAll% 'for PG all as Integer
Dim sFilter$ 'as String
On Error GoTo StartReport_Err
iCountEnd = 3000 '0 '= Total reports
sNoFormat = "00000"
'sReportName = "prova" ' this is a simple report with only one fix text
sReportName = "rptTest"
'sReportPath = "C:\log.txt"
sReportPath = "D:\Temp\Temp001.txt"
'Info in status bar:
If iCountEnd > 100 Then iMet100 = iCountEnd \ 100 Else iMet100 = 1
SysCmd acSysCmdClearStatus 'clear status bar
SysCmd acSysCmdInitMeter, "Printing Report " & sReportName & " ...", 100 '
If Dir(sReportPath, vbNormal) <> "" Then Kill sReportPath 'If file already present
DoCmd.OpenReport sReportName, acViewPreview ', , acHidden
Open sReportPath For Append As #1 ' this is a log file
For iCount = 1 To iCountEnd
sFilter = "RecID = " & iCount 'Filter by RecodID for example
'
Reports(sReportName).Filter = sFilter
Reports(sReportName).FilterOn = True
'Debug.Print "Filter: " & sFilter, vbInformation, "Printing Report " & sReportName
DoCmd.PrintOut , , , acMedium, 1 'Print One copy by new filter
Print #1, Format(iCount, sNoFormat); " - "; sReportName 'record to TXT file
'Info in status bar:
x = iCount \ iMet100
If x > iMetAll Then
iMetAll = x
'Debug.Print iMetAll & "%"
SysCmd acSysCmdUpdateMeter, iMetAll 'Show progress in status bar
End If
Next iCount
Reports(sReportName).Filter = ""
Reports(sReportName).FilterOn = False
DoCmd.Close acReport, sReportName 'Close report
MsgBox "Done!", vbInformation, "Printing Report " & sReportName
'Info in status bar:
SysCmd acSysCmdClearStatus 'clear status bar
StartReport_End:
On Error Resume Next
Close #1
Exit Function
StartReport_Err:
MsgBox "Error: " & Err.Number & vbCrLf & Err.Description & vbCrLf & _
"in Function: StartReport in module: 00ModuleForTests", vbCritical, "Error in Application"
Err.Clear
Resume StartReport_End
End Function