
Microsoft Access Office VB VBA Help and Examples	Microsoft Access Help	Search	Privacy	Contact

Output Multiple Reports to One Word File Automatically

You have a list of reports you have to send to a customer. This has to be done every so often and takes too long. As well as that the reports need to be in word format, which takes even more time, and there are 50 of them.

Create a new form. On this form put a list box called LIST0. Either fill the list box via code (see List all Reports example) or from a table via a query. Create a button called SENDIT. Go into the code for the form by clicking the code button on the toolbar and paste the following code.

Private Sub SENDIT_Click()
   On Error GoTo ERRORHANDLER
   Dim varItem As Variant
   If List0.ItemsSelected.Count>0 Then
      Dim AppWord As New Word.Application
      Dim DocWrd As Word.Document
      Dim i As Integer
      Dim Progress as String
      Dim EventTitle as String
      AppWord.Visible = True
      Set DocWrd= AppWord.Documents.Add
      DocWrd.PageSetup.TopMargin = 36
      DocWrd.PageSetup.BottomMargin = 36
      DocWrd.PageSetup.LeftMargin = 36
      DocWrd.PageSetup.RightMargin = 18
      i = 0
      For Each varItem In List0.ItemsSelected
         i = i + 1
         Progress = "Processing... " & List0.ItemData(varItem)
         DoCmd.OutputTo acOutputReport, List0.Column(0, varItem), acFormatRTF, "c:\temp\" & List0.ItemData(varItem) & ".rtf", False
         AppWord.Selection.InsertFile "c:\temp\" & List0.ItemData(varItem) & ".rtf", "", False, False, False
         If i < List0.ItemsSelected.Count Then
            AppWord.Selection.InsertBreak wdSectionBreakNextPage
         End If
      Next
      Progress = "Generating Email"
      DocWrd.SaveAs "c:\temp\" & EventTitle & ".doc", wdFormatDocument
      DocWrd.BuiltInDocumentProperties("Title").Value ="Set the title of the combined reports - " & Date
      DocWrd.Save
      AppWord.Activate
      AppWord.Options.SendMailAttach = True
      DocWrd.SendMail
      DocWrd.Close
      Set DocWrd = Nothing
      Set AppWord = Nothing
   End If
   Progress = ""
   Exit Sub

ERRORHANDLER:
    Progress = ""
    If MsgBox("Do you want to start over?", vbCritical + vbYesNo) = vbYes Then
        Err.Clear
        DocWrd.Close wdDoNotSaveChanges
        AppWord.Quit
        Exit Sub
    Else
        Err.Clear
        Resume
    End If
End Sub

Save the form and run it. Select the reports you want to send in the list and click the button. All the reports will be run and joined into one nice long word document. Then bring up your mail client with the document attached.

HOME SEARCH SITE PRIVACY POLICY CONTACT

The code and application content of this site is copyright of Smiley I.T. and as such reproduction in any form which is for commercial use requires the permission of the Webmaster. Any use of this code for non-commercial use only requires a link or comment back to the original page you took the code from.