PrintAccessRep

Public Sub RunRept_SQLAction(dbPath as String, _
           strReptName As String, intTime As Integer, _
           strSQLAction As String, intCopies As Integer)
  Dim strCurrent As String
  Dim strFuture As String
  Dim dbPath As String
  On Error Goto Err_Handler
 'Set mousepointer to hourglass
  Screen.MousePointer = vbHourglass
 'Open the database
  Application.OpenCurrentDatabase dbPath, False
 'Loop until all copies of the report are run
  Do Until intCopies = 0
    'just to make sure we never pass a negative number
     If intCopies < 0 Then Exit Sub 
       'set the future time by adding hours to
       'the current hours, minutes, or seconds
        strFuture = TimeSerial(Hour(Now), Minute(Now), Second(Now) + intTime)
        Do
          DoEvents
          strCurrent = TimeSerial(Hour(Now), Minute(Now), Second(Now))
          Loop While strCurrent < strFuture
         'Run the report since we are out of the loop
          With Application
            .DoCmd.SetWarnings False 
           '.DoCmd.OpenReport strReptName, acViewDesign
           '.Reports(strReptName).Filter = ' if your 
           'report has a filter place it here and uncomment 
           'these three lines
           '.DoCmd.Close acReport, strReptName, acSaveYes
            .DoCmd.OpenReport strReptName, acViewNormal ' print the report
            .DoCmd.SetWarnings True
          End With
          DoEvents
         'Decrement the amount of copies by one
          intCopies = intCopies - 1
        Loop
       'If we don't have a SQL Action then goto the exit routine 
        If strSQLAction = "" Then
            Resume Exit_Rtn
        End If
       'Run the timer
        strFuture = TimeSerial(Hour(Now), Minute(Now), Second(Now) + intTime)
        Do
          DoEvents
          strCurrent = TimeSerial(Hour(Now), Minute(Now), Second(Now))
          Loop While strCurrent < strFuture
         'Set the warnings = false and run the SQL Action desired then 
         'set the warnings = true again
          With Application.DoCmd
              .SetWarnings False
              .RunSQL strSQLAction
              .SetWarnings True
          End With
          Exit_Rtn:
         'Close the DB and set mousepointer back to default
          Application.CloseCurrentDatabase
          Screen.MousePointer = vbDefault
          Exit Sub
          Err_Handler:
          Select Case Err.Number
             Case 2486
               'This error means that Access is busy
                MsgBox "An Error occurred While printing " & _
                strReptName & ". Please try again later.", _
                vbOKOnly + vbExclamation, "Report Print Error"
             Case Else
                MsgBox Err.Number & " - " & Err.Description & _
                " An Error occurred While printing " & _
                strReptName & ". Please try again later. " & _
                "The database will now repaired and compacted.", _
                vbOKOnly + vbExclamation, "Report Print Error"
          End Select
      Reume Exit_Rtn
End Sub

Public Sub RunRept_SQLAction(dbPath as String, _
strReptName As String, intTime As Integer, _
strSQLAction As String, intCopies As Integer)
Dim strCurrent As String
Dim strFuture As String
Dim dbPath As String
On Error Goto Err_Handler
'Set mousepointer to hourglass

Screen.MousePointer = vbHourglass
'Open the database

Application.OpenCurrentDatabase dbPath, False
'Loop until all copies of the report are run

Do Until intCopies = 0
'just to make sure we never pass a negative number

If intCopies < 0 Then Exit Sub
'set the future time by adding hours to

'the current hours, minutes, or seconds

strFuture = TimeSerial(Hour(Now), Minute(Now), Second(Now) + intTime)
Do
DoEvents
strCurrent = TimeSerial(Hour(Now), Minute(Now), Second(Now))
Loop While strCurrent < strFuture
'Run the report since we are out of the loop

With Application
.DoCmd.SetWarnings False
'.DoCmd.OpenReport strReptName, acViewDesign

'.Reports(strReptName).Filter = ' if your

'report has a filter place it here and uncomment

'these three lines

'.DoCmd.Close acReport, strReptName, acSaveYes

.DoCmd.OpenReport strReptName, acViewNormal ' print the report
.DoCmd.SetWarnings True
End With
DoEvents
'Decrement the amount of copies by one

intCopies = intCopies - 1
Loop
'If we don't have a SQL Action then goto the exit routine

If strSQLAction = "" Then
Resume Exit_Rtn
End If
'Run the timer

strFuture = TimeSerial(Hour(Now), Minute(Now), Second(Now) + intTime)
Do
DoEvents
strCurrent = TimeSerial(Hour(Now), Minute(Now), Second(Now))
Loop While strCurrent < strFuture
'Set the warnings = false and run the SQL Action desired then

'set the warnings = true again

With Application.DoCmd
.SetWarnings False
.RunSQL strSQLAction
.SetWarnings True
End With
Exit_Rtn:
'Close the DB and set mousepointer back to default

Application.CloseCurrentDatabase
Screen.MousePointer = vbDefault
Exit Sub
Err_Handler:
Select Case Err.Number
Case 2486
'This error means that Access is busy

MsgBox "An Error occurred While printing " & _
strReptName & ". Please try again later.", _
vbOKOnly + vbExclamation, "Report Print Error"
Case Else
MsgBox Err.Number & " - " & Err.Description & _
" An Error occurred While printing " & _
strReptName & ". Please try again later. " & _
"The database will now repaired and compacted.", _
vbOKOnly + vbExclamation, "Report Print Error"
End Select
Reume Exit_Rtn
End Sub