We value your feedback.
Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!
Code is as follows: Dim RSLocation As Recordset Dim location As String Dim sqlstring As String Dim RSReports As ADODB.Recordset Dim query As String Dim file As String DoCmd.Hourglass True DoCmd.SetWarnings False Set RSLocation = CurrentDb.OpenRecordset("ReportLocation") If RSLocation.RecordCount = 0 Then MsgBox ("No location is present in the Report Location table") Exit Function End If RSLocation.MoveFirst location = RSLocation.Fields(1).Value RSLocation.Close Set RSLocation = Nothing If Right(location, 1) <> "\" Then location = location + "\" End If '2 Move through the OutputReport table and select records with print flag set sqlstring = "select QueryName, ReportName from OutputReport where Print= -1" Set RSReports = New ADODB.Recordset RSReports.CursorLocation = adUseClient RSReports.Open sqlstring, CurrentProject.Connection, adOpenForwardOnly, adLockReadOnly If Not (RSReports.EOF) And Not (RSReports.BOF) Then RSReports.MoveFirst While RSReports.EOF = False And RSReports.BOF = False query = RSReports.Fields(0).Value file = location + RSReports.Fields(1).Value On Error GoTo PrintError '3 Check to see if the file exists - if so remove (kill it) If Dir(file) <> "" Then Kill file End If '4 Run the Report DoCmd.OutputTo acOutputQuery, query, acFormatXLS, file, False RSReports.MoveNext Wend '5 Tidy up RSReports.Close Set RSReports = Nothing DoCmd.Hourglass False DoCmd.SetWarnings True MsgBox "Report out Completed", vbInformation Exit Function PrintError: If Err.Number = 53 Then Resume Next Else: MsgBox (Err.Description) End If DoCmd.Hourglass False DoCmd.SetWarnings True End Function
Add your voice to the tech community where 5M+ people just like you are talking about what matters.
Join the community of 500,000 technology professionals and ask your questions.