Home > other >  VBA Excel - Open two word documents and add all the info from one to the end of the other
VBA Excel - Open two word documents and add all the info from one to the end of the other

Time:09-04

I have a spreadsheet that I want to open two Word documents, do a bunch of stuff and then add all the contents of one to the end of the other. I've managed to figure out how to do the bunch of stuff, but for the life of me I can't seem to copy the contents of one to end of the other (which I thought would be the easiest part).

My code:

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 also not convinced that the contents of the FinalWording document is actually being copied, as 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've been closing this and opening again to have a variable to use (doc). As I don't need to save the word document, if there's an easier way of doing this without having to close and open it, I would greatly appreciate that.

Many thanks.

CodePudding user response:

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
  • Related