[SOLVED] Add all the info from one Word document to the end of another using Excel VBA

Add all the info from one Word document to the end of another using Excel VBA

I open two Word documents and do a bunch of stuff.

I want to add all the contents of one to the end of the other.

Sub Redate_OUT()

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.DisplayStatusBar = True

Dim sh As Worksheet

Set sh = ThisWorkbook.Sheets("Settings")

Dim pdf_path As String
Dim word_path As String
Dim Updated_path As String

pdf_path = sh.Range("E4").Value
Updated_path = sh.Range("E5").Value
word_path = "\\filestorage\cie\Operations\Results Team\Enquiries About Results\1.Series Folders\June 2022\4. Letters\OUT\Redater\Temporary Folder (Word)"

Dim fso As New FileSystemObject
Dim fo As Folder
Dim f As File
Dim MonthNo As Long
Dim MonthType As String
Dim Check As Boolean

Set fo = fso.GetFolder(pdf_path)

Dim wa As Object
Dim doc As Object
Dim FinalWording As Object

Set wa = CreateObject("word.application")
wa.Visible = True
 
Dim file_Count As Integer

Set FinalWording = wa.Documents.Open("\\filestorage\cie\Operations\Results Team\Enquiries About Results\1.Series Folders\June 2022\4. Letters\OUT\Redater\Final Wording.docx")

For Each f In fo.Files
    
    Application.StatusBar = "Converting - " & file_Count + 1 & "/" & fo.Files.Count
    Set doc = wa.Documents.Open(f.Path)
    doc.SaveAs2 (word_path & "\" & Replace(f.Name, ".pdf", ".docx"))
    doc.Close False
        
    Set doc = wa.Documents.Open(word_path & "\" & Replace(f.Name, ".pdf", ".docx"))
    
    For MonthNo = 12 To 1 Step -1
    
        MonthType = MonthName(MonthNo)
        
        With doc.Content.Find
            .Text = "?? " & MonthType & " 2022"
            .Replacement.Text = Format(Date, "dd") & " " & MonthName(Format(Date, "mm")) & " " & Format(Date, "yyyy")
            .MatchWildcards = True
            .MatchWholeWord = True
            .Execute Replace:=wdReplaceAll
    
            If .Found = True Then
            
                Check = True
                GoTo Done
                
            End If
    
        End With
    
    Next
    
Done:

    If Check = True Then
    
        With doc.Content.Find
        
            .Text = "If you believe we have not arrived at this outcome properly, * Enquiry About Results Team"
            .Replacement.Text = ""
            .MatchWildcards = True
            .MatchWholeWord = True
            .Execute Replace:=wdReplaceAll
            
        End With
        
        FinalWording.Content.WholeStory 'Select whole document
        Selection.Copy 'Copy your selection
        Documents(doc.Name).Activate 'Activate the other document
        Selection.EndKey wdStory 'Move to end of document
        Selection.PasteAndFormat wdPasteDefault 'Pastes in the content
        
        doc.ExportAsFixedFormat OutputFileName:=Updated_path & "/" & f.Name, ExportFormat:=wdExportFormatPDF, Range:=2
        doc.Close
              
    End If
    
    file_Count = file_Count + 1
Next

FinalWording.Close False

wa.Quit

Kill word_path & "\" & "*.docx"

MsgBox "All OUT Letters have been updated", vbInformation
Application.StatusBar = ""

End Sub

My main difficulty is with:

FinalWording.Content.WholeStory 'Select whole document
Selection.Copy 'Copy your selection
Documents(doc.Name).Activate 'Activate the other document
Selection.EndKey wdStory 'Move to end of document
Selection.PasteAndFormat wdPasteDefault 'Pastes in the content

I get an error

Object does not support this property or method

with:

Selection.EndKey wdStory 'Move to end of document

I'm not convinced that the contents of the FinalWording document is being copied. When I try to paste this manually after that line of code has run, nothing happens.

On a side note, after the PDF is saved as a Word document, I close this and open it again to have a variable to use (doc). As I don't need to save the Word document, is there an easier way.

Solution

You can replace this entire block:

FinalWording.Content.WholeStory 'Select whole document
Selection.Copy 'Copy your selection
Documents(doc.Name).Activate 'Activate the other document
Selection.EndKey wdStory 'Move to end of document
Selection.PasteAndFormat wdPasteDefault 'Pastes in the content

With:

doc.Characters.Last.FormattedText = FinalWording.Content.FormattedText