Open Word Doc and Save as New Word Doc

[Grant82]

I've created a macro in Excel to open a Word docx, swap out some content, and then I want to save as a new word docx as well as create a PDF. I have everything working except for the saving a new Word docx - can somebody help me getting it to work please?


This is what I'm trying to use for saving a new word docx - and if I remove this, the rest works perfectly.

ActiveDocument.SaveAs Filename:=ActiveWorkbook.Path & "/" & Cells(i, 1).Value & " " & Cells(i, 35).Value & " " & Cells(i, 39).Value & ".doc"

And here is the full script.

Sub Secondments()
    Dim wd As Word.Application
    Dim doc As Word.Document
    Set wd = New Word.Application
    wd.Visible = True
    Dim SetVarFromCell()
    Dim Y As Long
    Dim X As Long
    Y = Worksheets("User Input").Cells(32, "C").Value
    X = Y + 1
    Dim V As String
    Dim P As String
    Dim H As String
    Dim oRng As Word.Range
    Dim para As Word.Paragraph
    Dim found As Boolean
    Dim A As String
    A = ActiveWorkbook.Path & "\"
    ' MsgBox "The path is " & A, vbInformation
    For i = 2 To X
         V = Worksheets("Secondments").Cells(i, 31).Value
         P = Worksheets("Secondments").Cells(i, 33).Value
         H = Worksheets("Secondments").Cells(i, 20).Value
        Set doc = wd.Documents.Open(\\Hbap.adroot.hsbc\au\IT Operations\DATA\Restricted\HeadOffice\HPE\Recruitment Centre\Recruitment Process Australia\Offers\ _
        Secondments\Automated Letters\Secondme Template.docx<file://Hbap.adroot.hsbc/au/IT%20Operations/DATA/Restricted/HeadOffice/HPE/Recruitment%20Centre/ _
        Recruitment%20Process%20Australia/Offers/Secondments/Automated%20Letters/Secondment%20Template.docx>)
        If H = "N" Then
            Set oRng = wd.ActiveDocument.Range
            With oRng.Find
                .Text = "<<HDACopy1>>"
                .Wrap = wdFindStop
                 found = .Execute
                 Do While found
                     Set para = oRng.Next(wdParagraph, 1).Paragraphs(1)
                     para.Range.Delete
                     Set para = oRng.Next(wdParagraph, -1).Paragraphs(1)
                     para.Range.Delete
                     oRng.Collapse wdCollapseEnd
                     oRng.End = wd.ActiveDocument.Content.End
                     found = oRng.Find.Execute
                  Loop
             End With
         End If
         If H = "N" Then
             Set oRng = wd.ActiveDocument.Range
             With oRng.Find
                 .Text = "<<HDACopy5>>"
                 .Wrap = wdFindStop
                 found = .Execute
                 Do While found
                 Set para = oRng.Next(wdParagraph, 1).Paragraphs(1)
                 para.Range.Delete
                 Set para = oRng.Next(wdParagraph, -1).Paragraphs(1)
                 para.Range.Delete
                 oRng.Collapse wdCollapseEnd
                 oRng.End = wd.ActiveDocument.Content.End
                 found = oRng.Find.Execute
             Loop
          End With
       End If
       If V = "N" Then
           Set oRng = wd.ActiveDocument.Range
           With oRng.Find
               .Text = "<<VisaCopy>>"
               .Wrap = wdFindStop
               found = .Execute
               Do While found
                    Set para = oRng.Next(wdParagraph, 1).Paragraphs(1)
                    para.Range.Delete
                    Set para = oRng.Next(wdParagraph, -1).Paragraphs(1)
                    para.Range.Delete
                    oRng.Collapse wdCollapseEnd
                    oRng.End = wd.ActiveDocument.Content.End
                    found = oRng.Find.Execute
                Loop
            End With
        End If
        If P = "N" Then
             Set oRng = wd.ActiveDocument.Range
             With oRng.Find
                 .Text = "<<PTCopy>>"
                 .Wrap = wdFindStop
                 found = .Execute
                 Do While found
                     Set para = oRng.Next(wdParagraph, 1).Paragraphs(1)
                     para.Range.Delete
                     Set para = oRng.Next(wdParagraph, -1).Paragraphs(1)
                     para.Range.Delete
                     oRng.Collapse wdCollapseEnd
                     oRng.End = wd.ActiveDocument.Content.End
                     found = oRng.Find.Execute
                Loop
             End With
         End If
    With wd.Selection.Find
          .Text = "<<CandidateName>>"
          .Replacement.Text = Cells(i, 1).Value
          .Execute Replace:=wdReplaceAll
          .Text = "<<Date>>"
          .Replacement.Text = Cells(i, 39).Value
          .Execute Replace:=wdReplaceAll
          .Text = "<<Address1>>"
          .Replacement.Text = Cells(i, 3).Value
          .Execute Replace:=wdReplaceAll
          .Text = "<<Address2>>"
          .Replacement.Text = Cells(i, 4).Value
          .Execute Replace:=wdReplaceAll
          .Text = "<<Address3>>"
          .Replacement.Text = Cells(i, 5).Value
          .Execute Replace:=wdReplaceAll
          .Text = "<<EmployeeFirstName>>"
          .Replacement.Text = Cells(i, 6).Value
          .Execute Replace:=wdReplaceAll
          .Text = "<<PositionTitle>>"
          .Replacement.Text = Cells(i, 7).Value
          .Execute Replace:=wdReplaceAll
          .Text = "<<Salary>>"
          .Replacement.Text = Cells(i, 8).Value
          .Execute Replace:=wdReplaceAll
          .Text = "<<StartDate>>"
          .Replacement.Text = Cells(i, 43).Value
          .Execute Replace:=wdReplaceAll
          .Text = "<<GCBChange>>"
          .Replacement.Text = Cells(i, 11).Value
          .Execute Replace:=wdReplaceAll
          .Text = "<<HoursChange>>"
          .Replacement.Text = Cells(i, 14).Value
          .Execute Replace:=wdReplaceAll
          .Text = "<<ManagerName>>"
          .Replacement.Text = Cells(i, 17).Value
          .Execute Replace:=wdReplaceAll
          .Text = "<<ManagerTitle>>"
          .Replacement.Text = Cells(i, 18).Value
          .Execute Replace:=wdReplaceAll
          .Text = "<<CostCentre>>"
          .Replacement.Text = Cells(i, 19).Value
          .Execute Replace:=wdReplaceAll
          .Text = "<<HDACopy1>>"
          .Replacement.Text = Cells(i, 24).Value
          .Execute Replace:=wdReplaceAll
          .Text = "<<HDACopy2>>"
          .Replacement.Text = Cells(i, 25).Value
          .Execute Replace:=wdReplaceAll
          .Text = "<<HDACopy3>>"
          .Replacement.Text = Cells(i, 26).Value
          .Execute Replace:=wdReplaceAll
          .Text = "<<HDACopy4>>"
          .Replacement.Text = Cells(i, 27).Value
          .Execute Replace:=wdReplaceAll
          .Text = "<<HDACopy5>>"
          .Replacement.Text = Cells(i, 28).Value
          .Execute Replace:=wdReplaceAll
          .Text = "<<VisaCopy>>"
          .Replacement.Text = Cells(i, 32).Value
          .Execute Replace:=wdReplaceAll
          .Text = "<<PTCopy>>"
          .Replacement.Text = Cells(i, 34).Value
          .Execute Replace:=wdReplaceAll
          .Text = "<<EndDate>>"
          .Replacement.Text = Cells(i, 47).Value
          .Execute Replace:=wdReplaceAll
       End With
       ActiveDocument.SaveAs Filename:=ActiveWorkbook.Path & "/" & Cells(i, 1).Value & " " & Cells(i, 35).Value & " " & Cells(i, 39).Value & ".doc"
       doc.ExportAsFixedFormat OutputFileName:=ActiveWorkbook.Path & "/" & Cells(i, 1).Value & " " & Cells(i, 35).Value & " " & Cells(i, 39).Value & ".pdf", _
       ExportFormat:=wdExportFormatPDF
       Application.DisplayAlerts = False
       doc.Close SaveChanges:=False
       Application.DisplayAlerts = True
    Next
    wd.Quit
End Sub