Change field reference source file using VBA

Question

I have several hundred Microsoft word documents that have dozens of Microsoft Excel Worksheet links.  I copy all these files from project to project and need the reference to the excel file location to change.  I would like the code to do the following:

Ask me if I want to change the source reference file

Ask me if I want to update links in Headers, footers, table of contents, text, etc.

Ask me if I want to print files (if yes maybe pick the printer to print to)

Ask me if I want to save the file

Ask me to pick the excel file that has the information

Ask me to pick a folder where the word documents that need to be changed are located (maybe with an option to include sub folders)

Change the location of the source file if answered yes

For example; the existing link is:

{ LINK Excel.Sheet.12 "\\od\corp-file-ns01\I\File\SPEC\Working Documents Folder\Contract Documents Template.xlsx" Sheet1!R22C2 \a \f 4 \r \* MERGEFORMAT } (this is actual text from the word document)

And the new link should be:

{ LINK Excel.Sheet.12 "\\od\corp-file-ns01\I\Water\Specifications\Contract Documents Template.xlsx" Sheet1!R1C2 \a \f 4 \r \* MERGEFORMAT } (this is actual text from the word document)

Update each type of link if answered yes

Print file if answered yes

Save file if answered yes

My Word version is 2013.

I have done some research and know a few things like the links in the headers and footers have to be handled separately from the links in the body, but I'm not a programmer.  Looks like I'm looking at several subroutines in the module with each one being called if the answer to the questions is yes.  Thanks in advance for all the help.

Answer 1

The macro in the link I posted also updates links in all story ranges...

Answer 2

The ActiveDocument.Fields collection only includes the fields in the main body of the document; any fields in text boxes or headers and footers are ignored. The example macro at http://www.gmayor.com/installing_macro.htm discusses how you can access so-called story ranges outside of the main body of the document.

Answer 3

I finally had some time to work on this and seemed to have successfully altered the code to work on links in the document body but it doesn't work on links in headers and footers.  I'll keep working on it.  Here is the altered code.  I’m also not sure why but choosing a word document in the folder I want to process doesn’t work correctly.

Sub ContractDocumentLinks()

'

'

    Dim Alink As Field

    Dim LinkCode As Range

    Dim LinkFile As Range

    Dim LinkLocation As Range

    Dim LinkType As Range

    Dim i As Integer

    Dim j As Integer

    Dim Message, Title, Newfile

    Dim fDialog As FileDialog

    Dim Counter As Integer

    Dim JName As String

    Dim EA As Excel.Application

    Dim EB As Workbook

    Dim UpdateLinksAnswer As String

    Dim PrintAnswer As String

    Counter = 0

    Set EA = New Excel.Application

    EA.Visible = False

    UpdateLinksAnswer = MsgBox("Do you wish to update links?", vbInformation + vbYesNo)

    PrintAnswer = MsgBox("Do you wish to print files to the default printer?", vbInformation + vbYesNo)

    MsgBox "Please choose the contract documents template excel file"

    Set fDialog = Application.FileDialog(msoFileDialogFilePicker)

    With fDialog

        .Title = Message

        .Filters.Clear

        .Filters.Add "Excel File", "*.xlsx"

        .AllowMultiSelect = False

        .InitialView = msoFileDialogViewList

        If .Show <> -1 Then

            MsgBox "Cancelled By User", , Title

            Exit Sub

        End If

        Newfile = fDialog.SelectedItems.Item(1)

        Newfile = Replace(Newfile, "", "\")

    End With

    Word.Options.UpdateLinksAtOpen = False

    MsgBox "Please choose a document in the folder you wish to process"

    With Dialogs(wdDialogFileOpen)

        .Name = "*.docx"

        .Show

        If .Show <> -1 Then

            MsgBox "Cancelled By User", , Title

            Exit Sub

        End If

    End With

    Application.Visible = False

    Application.ScreenUpdating = False

    JName = Dir("*.docx")

    While (JName > "")

        Application.Documents.Open FileName:=JName

        With ActiveDocument

            If ActiveDocument.ReadOnly = False Then

                For Each Alink In ActiveDocument.Fields

                    If Alink.Type = wdFieldLink Then

                        Set LinkCode = Alink.Code

                        i = InStr(LinkCode, Chr(34))

                        Set LinkType = Alink.Code

                        LinkType.End = LinkType.Start + i

                        j = InStr(Mid(LinkCode, i + 1), Chr(34))

                        Set LinkLocation = Alink.Code

                        LinkLocation.Start = LinkLocation.Start + i + j - 1

                        If Counter = 0 Then

                            Set LinkFile = Alink.Code

                            LinkFile.End = LinkFile.Start + i + j - 1

                            LinkFile.Start = LinkFile.Start + i

                        End If

                        LinkCode.Text = LinkType & Newfile & LinkLocation

                        Counter = Counter + 1

                        If UpdateLinksAnswer = vbYes Then

                            Alink.Update

                        End If

                    End If

                Next Alink

                If (PrintAnswer = vbYes) Then

                    'Include the following 2 lines of code to set view to FINAL instead of showing markups on print

                    ActiveWindow.View.ShowRevisionsAndComments = False

                    ActiveWindow.View.RevisionsView = wdRevisionsViewFinal

                    ActiveDocument.PrintOut

                    ActiveDocument.Close SaveChanges:=wdSaveChanges

                Else

                    ActiveDocument.Close SaveChanges:=wdSaveChanges

                End If

            Else

                ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges

            End If

        End With

        JName = Dir()

    Wend

    Application.ScreenUpdating = True

    Word.Options.UpdateLinksAtOpen = True

    MsgBox "Your Files Have Been Processed"

End Sub

Answer 4

To see how to implement relative paths in Word, check out the macro solution I've posted at:

http://windowssecrets.com/forums/showthread.php/154379-Word-Fields-and-Relative-Paths-to-External-Files

Answer 5

O.K., here is my first stab.  Like I said, I'm not a programmer.  I did some searching and combined several things I found into this.  I know it's terrible and doesn't work but I thought I needed something to get the replies rolling on this.  I think this could be helpful to a lot of people and hope we get a solution.  I have documents ready for testing.

Sub ContractDocumentLinks()

'

' ContractDocumentLinks Macro

' Thanks to Macropod for much of the code

'

    Dim dlink As Field

    Dim dlinkcode As Range

    Dim dlinkfile As Range

    Dim dlinklocation As Range

    Dim dlinktype As Range

    Dim i As Integer

    Dim j As Integer

    Dim Title, Newfile

    Dim ddialog As FileDialog

    Dim Counter As Integer

    Dim dname As String

    Dim EA As Excel.Application

    Dim EB As Workbook

    Dim UpdateLinksAnswer As String

    Dim PrintAnswer As String

    Counter = 0

    Set EA = New Excel.Application

    EA.Visible = False

    UpdateLinksAnswer = MsgBox("Do You Wish To Update Links?", vbInformation + vbYesNo)

    PrintAnswer = MsgBox("Do You Wish To Print Files To The Default Printer?", vbInformation + vbYesNo)

    Set ddialog = Application.FileDialog(msoFileDialogFilePicker)

    With ddialog

        .Title = "Please Choose The Contract Documents Template Excel File"

        .Filters.Clear

        .Filters.Add "Excel File", "*.xlsx"

        .AllowMultiSelect = False

        .InitialView = msoFileDialogViewList

        If .Show <> -1 Then

            MsgBox "Cancelled By User, No Files Were Processed", , Title

            Exit Sub

        End If

        Newfile = ddialog.SelectedItems.Item(1)

        'Newfile = Right(Newfile, Len(Newfile) - InStrRev(Newfile, ""))

        Newfile = Replace(Newfile, "", "\")

    End With

    Word.Options.UpdateLinksAtOpen = False

    With Dialogs(wdDialogFileOpen)

        '.Title = "Please Choose A Document In The Folder You Wish To Process"

        .Name = "*.docx"

        .Show

        If .Show <> -1 Then

            MsgBox "Cancelled By User, No Files Were Processed", , Title

            Exit Sub

        End If

    End With

    Application.Visible = False

    Application.ScreenUpdating = False

    dname = Dir("*.docx")

    While (dname > "")

        Application.Documents.Open FileName:=dname

        With ActiveDocument

            If ActiveDocument.ReadOnly = False Then

                For Each dlink In ActiveDocument.Fields

                    If dlink.Type = wdFieldLink Then

                        Set dlinkcode = dlink.Code

                        i = InStr(dlinkcode, Chr(34))

                        Set dlinktype = dlink.Code

                        dlinktype.End = dlinktype.Start + i

                        j = InStr(Mid(dlinkcode, i + 1), Chr(34))

                        Set dlinklocation = dlink.Code

                        dlinklocation.Start = dlinklocation.Start + i + j - 1

                        If Counter = 0 Then

                            Set dlinkfile = dlink.Code

                            dlinkfile.End = dlinkfile.Start + i + j - 1

                            dlinkfile.Start = dlinkfile.Start + i

                        End If

                        dlinkcode.Text = dlinktype & Newfile & dlinklocation

                        Counter = Counter + 1

                        If UpdateLinksAnswer = vbYes Then

                            dlink.Update

                        End If

                    End If

                Next dlink

                    For Each oStory In ActiveDocument.StoryRanges

        oStory.Fields.Update    'update fields in all stories

    Next oStory

    For Each oToc In ActiveDocument.TablesOfContents

        oToc.Update    'update TOC's

    Next oToc

                If (PrintAnswer = vbYes) Then

Call PrintFiles

                Else

                    ActiveDocument.Close SaveChanges:=wdSaveChanges

                End If

            Else

                ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges

            End If

        End With

        dname = Dir()

    Wend

    Application.ScreenUpdating = True

    Word.Options.UpdateLinksAtOpen = True

    MsgBox "Your Files Have Been Processed"

End Sub

Sub PrintFiles()

'Include the following 2 lines of code to set view to FINAL instead of showing markups on print

    ActiveWindow.View.ShowRevisionsAndComments = False

    ActiveWindow.View.RevisionsView = wdRevisionsViewFinal

    ActiveDocument.PrintOut

End Sub

Sub SaveChanges()

    ActiveDocument.Close SaveChanges:=wdSaveChanges

End Sub

Sub DoNotSaveChanges()

    ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges

End Sub

Sub RedirectLinks()

End Sub

Sub UpdateLinks()

    For Each oStory In ActiveDocument.StoryRanges

        oStory.Fields.Update    'update fields in all stories

    Next oStory

    For Each oToc In ActiveDocument.TablesOfContents

        oToc.Update    'update TOC's

    Next oToc

End Sub