Copy Content from One Word Doc to Another

JonXL

Active Member
Joined
Feb 5, 2018
Messages
417
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
Hi,

I'm trying to append the contents from one Word file to another. Here is more or less what I'm doing now.

VBA Code:
Sub AppendDocument()
    Dim wdDoc As Document, wdOutputDoc As Document
    
    Set wdDoc = Documents.Add
    Set wdDoc = Documents.Add
    
    With wdDoc
    
        Do
              
            'do some stuff to this document
            
            .Content.Copy
            
            With wdOutputDoc.Content
                .Collapse direction:=wdCollapseEnd
                .InsertBreak wdPageBreak
                .PasteAndFormat wdFormatOriginalFormatting
            End With
        
        Loop
    
    End With

End Sub

This works... except because it uses the clipboard, it's open to get junk in it if someone copies between the copy and paste commands of this code. (I tested this while it was running by rapidly and repeatedly copying 'blah' to the clipboard and in at least one instance the appended content was 'blah' and not the contents of the document I wanted appended.)

When I try by using like this ...
VBA Code:
            With wdOutputDoc.Content
                .Collapse direction:=wdCollapseEnd
                .InsertBreak wdPageBreak
                .InsertAfter wdDoc.Content
            End With

... it doesn't include the headings, etc.

I've looked into InsertFile but as you can see from the code, both documents are created in the code and never saved, so there isn't a file location to use. If watching the screen while it runs, you see variably Document1, Document2 or Document3, Document6, etc. - they are not saved files. But maybe there's a way with InsertFile even though they aren't saved.

Otherwise, I'm not sure what options there are for this to work.

Thank you,
Jon
 

Some videos you may like

Excel Facts

Select all contiguous cells
Pressing Ctrl+* (asterisk) will select the "current region" - all contiguous cells in all directions.

Macropod

Retired Moderator
Joined
Aug 27, 2007
Messages
3,515
Pretty basic, really:
VBA Code:
Sub AppendDocument()
Dim DocSrc As Document, DocTgt As Document
Set DocSrc = ActiveDocument
Set DocTgt = Documents.Add
'Do whatever pre-processing you want, then:
DocTgt.Range.Characters.Last.FormattedText = DocSrc.Range.FormattedText
End Sub
 

JonXL

Active Member
Joined
Feb 5, 2018
Messages
417
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
Thank you. Unfortunately that doesn't bring over the headings. This is what I have:

VBA Code:
Sub AppendDocument()
    wdOutputDoc As Document
  
    Set wdOutputDoc = Documents.Add

    wdOutputDoc.Range.Characters.Last.FormattedText = ThisDocument.Range.FormattedText

End Sub

Unlike the copy-paste commands, this doesn't bring over all the content from the document. It's only bringing over the body text and not the headings, text boxes, etc.
 

Macropod

Retired Moderator
Joined
Aug 27, 2007
Messages
3,515
On the contrary, it brings over exactly the same content a copy/paste would, including headings and textboxes. Perhaps the problem is that you're using 'ThisDocument' instead of 'ActiveDocument'. If you want to replicate hears and footers, you need to use the same method on those, too.

See, more fully: Combine Multiple Word Documents (msofficeforums.com)
 
Solution

JonXL

Active Member
Joined
Feb 5, 2018
Messages
417
Office Version
  1. 365
  2. 2016
Platform
  1. Windows

ADVERTISEMENT

Perhaps the problem is that you're using 'ThisDocument' instead of 'ActiveDocument'.

That didn't seem to make a difference.

If you want to replicate hears and footers, you need to use the same method on those, too.

Do you mean I'd have to have that for each of the document's ranges?


Thank you for that link. With some tweaking to reference the currently opened files that does what I need it to do (the first sub with my changes, need a little more cleanup as this was just for testing):
VBA Code:
Sub CombineDocuments()
Application.ScreenUpdating = True
Dim strFolder As String, strFile As String, strTgt As String
Dim wdDocTgt As Document, wdDocSrc As Document, HdFt As HeaderFooter
'strFolder = GetFolder: If strFolder = "" Then Exit Sub
Set wdDocTgt = Documents.Add 'ActiveDocument: strTgt = ActiveDocument.FullName
strFile = Dir(strFolder & "\*.doc", vbNormal)
'While strFile <> ""
  If 1 = 1 Then 'strFolder & strFile <> strTgt Then
    Set wdDocSrc = ThisDocument 'Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
    With wdDocTgt
      .Characters.Last.InsertBefore vbCr
      .Characters.Last.InsertBreak (wdSectionBreakNextPage)
      With .Sections.Last
        For Each HdFt In .Headers
          With HdFt
            .LinkToPrevious = False
            .Range.Text = vbNullString
            .PageNumbers.RestartNumberingAtSection = True
            .PageNumbers.StartingNumber = wdDocSrc.Sections.First.Headers(HdFt.Index).PageNumbers.StartingNumber
          End With
        Next
        For Each HdFt In .Footers
          With HdFt
            .LinkToPrevious = False
            .Range.Text = vbNullString
            .PageNumbers.RestartNumberingAtSection = True
            .PageNumbers.StartingNumber = wdDocSrc.Sections.First.Headers(HdFt.Index).PageNumbers.StartingNumber
          End With
        Next
      End With
      Call LayoutTransfer(wdDocTgt, wdDocSrc)
      .Range.Characters.Last.FormattedText = wdDocSrc.Range.FormattedText
      With .Sections.Last
        For Each HdFt In .Headers
          With HdFt
            .Range.FormattedText = wdDocSrc.Sections.Last.Headers(.Index).Range.FormattedText
            .Range.Characters.Last.Delete
          End With
        Next
        For Each HdFt In .Footers
          With HdFt
            .Range.FormattedText = wdDocSrc.Sections.Last.Footers(.Index).Range.FormattedText
            .Range.Characters.Last.Delete
          End With
        Next
      End With
    End With
    'wdDocSrc.Close SaveChanges:=False
  End If
  'strFile = Dir()
'Wend
With wdDocTgt
  ' Save & close the combined document
  '.SaveAs FileName:=strFolder & "Forms.docx", FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False
  ' and/or:
  '.SaveAs FileName:=strFolder & "Forms.pdf", FileFormat:=wdFormatPDF, AddToRecentFiles:=False
  '.Close SaveChanges:=False
End With
Set wdDocSrc = Nothing: Set wdDocTgt = Nothing
Application.ScreenUpdating = True
End Sub

I wish there were a way to do this in one go like copy-paste, though. This runs in a little under a second which could add up quick with a lot of documents.
 

Macropod

Retired Moderator
Joined
Aug 27, 2007
Messages
3,515
Do you mean I'd have to have that for each of the document's ranges?
Indeed I do.

I wish there were a way to do this in one go like copy-paste, though. This runs in a little under a second which could add up quick with a lot of documents.
Except for the clipboard, copy/paste doesn't work any differently.

You've omitted the LayoutTransfer Sub from the link I gave you. IF all the documents have the same page layout, you could omit both that sub and the line:
VBA Code:
Call LayoutTransfer(wdDocTgt, wdDocSrc)
You could possibly also delete the two instances of:
VBA Code:
            .PageNumbers.RestartNumberingAtSection = True
            .PageNumbers.StartingNumber = wdDocSrc.Sections.First.Headers(HdFt.Index).PageNumbers.StartingNumber
These measures would help the code run more quickly.

Still, complaining that the code "runs in a little under a second" for each document seems churlish given the time it saves over doing the same thing manually.
 

JonXL

Active Member
Joined
Feb 5, 2018
Messages
417
Office Version
  1. 365
  2. 2016
Platform
  1. Windows

ADVERTISEMENT

Except for the clipboard, copy/paste doesn't work any differently.

The issue with that approach is that the time between the copy and the paste leaves room for the users to put something else into the clipboard which then gets pasted instead of the contents of the document.

You've omitted the LayoutTransfer Sub from the link I gave you.

I have it in the code I ran - I just posted the parts that I tweaked; I left LayoutTransfer as it was.

IF all the documents have the same page layout, you could omit both that sub and the line:
VBA Code:
Call LayoutTransfer(wdDocTgt, wdDocSrc)
You could possibly also delete the two instances of:
VBA Code:
            .PageNumbers.RestartNumberingAtSection = True
            .PageNumbers.StartingNumber = wdDocSrc.Sections.First.Headers(HdFt.Index).PageNumbers.StartingNumber
These measures would help the code run more quickly.

We're a little over half a second, now. I'll keep playing with it and see what else can be done. I imagine I'd have to transfer the layout in the first loop, though, right? After that, they will have the same layout and then I would skip that...?

Still, complaining that the code "runs in a little under a second" for each document seems churlish given the time it saves over doing the same thing manually.

Absolutely! But if working with thousands of documents, every second adds up big in the end, so I'm looking for the quickest way to run this.

My original setup was making and saving the document over and over again from a template and then combining them. The code you've provided is without a doubt a significant improvement the way it is, so I certainly appreciate you bringing that here. I'm not attempting to be ungrateful at all. :)

Thank you.
 

Macropod

Retired Moderator
Joined
Aug 27, 2007
Messages
3,515
Well, the code In the link I posted automates the combining of a whole folder of documents. You've clobbered all of that, meaning you'll still have to do them one at a time. Not an improvement, methinks.
 

JonXL

Active Member
Joined
Feb 5, 2018
Messages
417
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
Well, the code In the link I posted automates the combining of a whole folder of documents. You've clobbered all of that, meaning you'll still have to do them one at a time. Not an improvement, methinks.

Not sure what's been clobbered. I used the code (with modifications to fit my circumstances) and it is correctly appending from one document onto the next. There is no "one at a time" as everything is done in the code without the user being involved.

I think it works well. And I genuinely appreciate the code since the alternative wasn't workable.

Thank you.
 

Watch MrExcel Video

Forum statistics

Threads
1,123,517
Messages
5,602,120
Members
414,505
Latest member
quoctrungvu99

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top