Sub BuildDocFromSections()
Dim wdApp As Word.Application
Dim docNew As Word.Document
Dim docSource As Word.Document
Dim sourcesections As Variant
Dim i As Integer
Dim bNewInstance As Boolean
'try to use an existing instance of Word
On Error Resume Next 'supress error reporting
Set wdApp = GetObject(, "Word.Application")
On Error GoTo 0 're-enable error reporting
If wdApp Is Nothing Then
'Word not running, so create a new instance
Set wdApp = CreateObject("Word.Application")
wdApp.Visible = True 'Optional. Code will still work with hidden application
bNewInstance = True
End If
sourcesections = Array(2, 6, 8)
Set docSource = wdApp.Documents.Open("C:\MyFolder\MyTemplate.dot")
Set docNew = wdApp.Documents.Add
For i = 0 To 2
docSource.Sections(sourcesections(i)).Range.Copy
docNew.Bookmarks("\EndOfDoc").Range.Paste
Next i
docSource.Close wdDoNotSaveChanges
'Save new document and close application unless it was already running
docNew.SaveAs "C:\MyFolder\MyNewDoc.dot"
If bNewInstance Then
wdApp.Quit
End If
End Sub
|