OO-Snippets: insert document into another

Commons

KeywordsLoadComponentFromUrl, InsertDocumentFromUrl , StoreAsURL, Merge, Insert
LanguageOOBasic
ApplicationWriter
AuthorsLaurent Godard (initial)
Andrew Pitonyak
Michael Hönnig
Tom Schindl
Supported Versions
Supported OS
Question

How can I insert one document into another?

I run a mail merge, which creates one file for each address. I want to merge all of the documents into one document.

Answer

This utility retrieves all write documents in a directory and creates a single output file that contains all of the documents combined into one. A page break is inserted before each new document.

This macro demonstrates many features in OOo. For example, the correct mechanism is used to close an existing document. The close method is used if it is supported and dispose is used if it is not supported. As of OOo 1.1, close should be supported.

Although the user is asked which directory should contain the combined file, the name of the combined file is hard coded to be "ResultatFusion.sxw". If this file already exists, it will probably be overwritten. You have been warned! The first Write file found is copied to the destination file, overwriting any existing file. The file is then opened. Each additional file is appended to the end of this file. When the process is completed, the file is saved to disk and then reopened.

Code-Snippet-Listing (snippet-source)

Sub MergeDocumentsInDirectory()
  
  Dim DestDirectory As String
  Dim FileName As String
  Dim SrcFile As String, DstFile As String 
  Dim oDesktop, oDoc, oCursor, oText
  Dim argsInsert()
  Dim args()
  ' Remove the following comments to do things hidden
  ' dim args(0) as new com.sun.star.beans.PropertyValue
  ' args(0).name = "Hidden"
  ' args(0).value = true
 
  ' Which desitnation directory?
  DestDirectory = Trim( GetFolderName() )

  If DestDirectory = "" Then
    MsgBox "No directory selected, exiting",16,"Merging Documents"
    Exit Sub
  End If

  ' force a trailing backslash. This is okay because using URL notation
  If Right(DestDirectory,1) <> "/" Then
    DestDirectory = DestDirectory & "/"
  End If

  oDeskTop = CreateUnoService("com.sun.star.frame.Desktop")
 
  ' Read the first file!
  FileName = Dir(DestDirectory)
  DstFile = ConvertToURL(DestDirectory & "ResultatFusion.sxw")
  Do While FileName <> ""
    If lcase( right(FileName,3)) = "sxw" Then
      SrcFile = ConvertToURL(DestDirectory & FileName)
      If IsNull(oDoc) OR IsEmpty(oDoc) Then
        FileCopy( SrcFile, DstFile )
        oDoc = oDeskTop.Loadcomponentfromurl(DstFile, "_blank", 0, Args())
        oText = oDoc.getText
        oCursor = oText.createTextCursor()
      Else
        oCursor.gotoEnd(false)
        oCursor.BreakType = com.sun.star.style.BreakType.PAGE_BEFORE
        oCursor.insertDocumentFromUrl(SrcFile, argsInsert())
      End If
    End If
    FileName = dir()
  Loop
 
  If IsNull(oDoc) OR IsEmpty(oDoc) Then
    MsgBox "No documents merged!",16,"Merging Documents" 
    Exit Sub
  End If

  ' Save the document
  Dim args2()
  oDoc.StoreAsURL(DestDirectory & "ResultatFusion.sxw",args2())
  If HasUnoInterfaces(oDoc, "com.sun.star.util.XCloseable") Then
    oDoc.close(true)
  Else
    oDoc.dispose
  End If
 
  ' Reload the document!
  oDoc=oDeskTop.Loadcomponentfromurl(DstFile,"_blank",0,Args2())
End Sub

Changelog

DateUserModification
2004-06-22tomsontomModified to match codesnippet.dtd v2.0, added syntax highlighting
0000-00-00lauinitial version

and