Consulting

Results 1 to 9 of 9

Thread: Excel VBA Open Word Doc and Save as New Word Doc

  1. #1
    VBAX Newbie
    Joined
    Apr 2024
    Posts
    3
    Location

    Excel VBA Open Word Doc and Save as New Word Doc

    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\Secondment 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

  2. #2
    Moderator VBAX Wizard Aussiebear's Avatar
    Joined
    Dec 2005
    Location
    Queensland
    Posts
    5,232
    Location
    Welcome to VBAX Grant82. I notice you have two loops of "If H = "N"". A typo perhaps?
    Remember To Do the Following....
    Use [Code].... [/Code] tags when posting code to the thread.
    Mark your thread as Solved if satisfied by using the Thread Tools options.
    If posting the same issue to another forum please show the link

  3. #3
    VBAX Newbie
    Joined
    Apr 2024
    Posts
    3
    Location
    Hi Aussiebear, thanks for taking a look! That part is OK though - the first loop is removing spacing around <<HDACopy1>> and the second one is removing space around <<HDACopy5>>. All the code except for the line I use to try to save as a new word doc does work however - it's just that one bit I need some help with.

    If I comment this bit out the rest runs and completes successfully outputting a PDF. But, I want a new word doc saved as well as the PDF - so how do I get this bit working?

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

  4. #4
    Moderator VBAX Wizard Aussiebear's Avatar
    Joined
    Dec 2005
    Location
    Queensland
    Posts
    5,232
    Location
    Okay so the system is playing games with me. What I had meant to say is the Slash should be backwards not forwards
    Remember To Do the Following....
    Use [Code].... [/Code] tags when posting code to the thread.
    Mark your thread as Solved if satisfied by using the Thread Tools options.
    If posting the same issue to another forum please show the link

  5. #5
    VBAX Newbie
    Joined
    Apr 2024
    Posts
    3
    Location
    I finally got it sussed - here's what worked-

    wd.ActiveDocument.SaveAs2 Filename:=ActiveWorkbook.Path & "/" & Cells(i, 1).Value & " " & Cells(i, 35).Value & " " & Cells(i, 39).Value & ".docx"

  6. #6
    Moderator VBAX Wizard Aussiebear's Avatar
    Joined
    Dec 2005
    Location
    Queensland
    Posts
    5,232
    Location
    Glad you arrived at a solution. I'm sure the Word guru's when they arrive, might put their two cents in as well so keep an eye on this thread of yours. Do you wan tto mark the thread as solved? If so go to Thread tools, scroll down to Mark this thread as Solved please?
    Remember To Do the Following....
    Use [Code].... [/Code] tags when posting code to the thread.
    Mark your thread as Solved if satisfied by using the Thread Tools options.
    If posting the same issue to another forum please show the link

  7. #7
    snb
    Guest
    You should use Docvariables instead of find/replace.

    To open a Word documnet:

    With getobject("G:\OF\sample.docx")
    
    End With
    To read values in an Excel document use an array; so you can reduce the interaction with the sheet to once.

  8. #8
    VBAX Expert Dave's Avatar
    Joined
    Mar 2005
    Posts
    855
    Location
    Excel VBA Open Word Doc and Save as New Word Doc | MrExcel Message Board
    Maybe review both sites guidelines re. cross posting
    Dave

  9. #9
    Moderator VBAX Wizard Aussiebear's Avatar
    Joined
    Dec 2005
    Location
    Queensland
    Posts
    5,232
    Location
    Well, thats disappointing.....
    Remember To Do the Following....
    Use [Code].... [/Code] tags when posting code to the thread.
    Mark your thread as Solved if satisfied by using the Thread Tools options.
    If posting the same issue to another forum please show the link

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •