Home   |   Parenting   |   Bible Corner   |   Programming   |   Links   |   Guestbook
  
Programming - Document Merging

Make sure and include the Microsoft Word library in your project (from the project references dialog).


Private Sub btnCreateDocument_Click()
Dim WordApp As Word.Application
Dim WordDoc As Word.Document

    ' I'm getting my list of word documents from a list box
    ' called list1.  I'm using the next line to check if there
    ' has been any documents selected.  If not - it will exit this
    ' subroutine.
    If List1.ListCount = 0 Then Exit Sub
   
    Set WordApp = CreateObject("word.application")
    Set WordDoc = WordApp.Documents.Add()
    
    On Error Resume Next
    ProgressBar1.Value = 0
    ProgressBar1.Max = List1.ListCount
    
    For i = 0 To List1.ListCount - 1
    
        WordApp.Selection.InsertFile List1.List(i)
        If Not i = List1.ListCount - 1 Then
            WordApp.Selection.InsertBreak wdSectionBreakNextPage
        End If

        ' Find the orientation of the original document and apply it to the new document selection.
        ' This allows us to create a document incorporating both landscape and portrait pages.
        WordDoc.Sections(i + 1).PageSetup.Orientation = GetOrientation(List1.List(i))
        ProgressBar1.Value = i + 1
        
    Next
    
    ' Don't forget to include the microsoft common
    ' dialog control into your for these next 2 lines to work.
    CommonDialog1.Filter = "MS Word Document (*.doc) | *.doc"
    CommonDialog1.ShowSave
        
    WordDoc.SaveAs CommonDialog1.FileName
    WordDoc.Close
    WordApp.Quit
    
    Set WordDoc = Nothing
    Set WordApp = Nothing
    Frame1.Enabled = True
    
End Sub

Private Function GetOrientation(FileName As String) As Integer
Dim WordApp As Word.Application
Dim WordDoc As Word.Document

    Set WordApp = CreateObject("Word.Application")
    Set WordDoc = WordApp.Documents.Open(FileName)
       
    GetOrientation = WordDoc.PageSetup.Orientation
    
    WordDoc.Close
    WordApp.Quit
    
    Set WordDoc = Nothing
    Set WordApp = Nothing
    
End Function

Version 2, July 2000 ©Alastair Vance - Email: vance@ukonline.co.uk