Microsoft Access Office VB VBA Help and Examples
           
             

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.