Change Links to Excel Programmatically through Dialogue Box

[KC VBA Qns]

Hi,

I am new boy to the block, especially to Word VBA I am a new born.

This is the all time referenced solution by Doug Robbins created on
26/10/01 to updating ALL the links to Excel sources in a Word doc in
one simple step. I tried and the end result is that ALL links,
originally referencing to different Excel files, are now pointing to
the one and only one common Excel file.

Could someone help tweak the codes so as to check, summarize and prompt
users to change only for the unique sources?

Dim alink As Field, linktype As Range, linkfile As Range
Dim linklocation As Range, i As Integer, j As Integer, linkcode As
Range
Dim Message, Title, Default, Newfile
Dim counter As Integer
counter = 0
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
Message = "Enter the modified path and filename
following this Format " & linkfile
Title = "Update Link"
Default = linkfile
Newfile = InputBox(Message, Title, Default)
End If
linkcode.Text = linktype & Newfile & linklocation
counter = counter + 1
End If
Next alink


Rgds,

 

[macropod]

Hi KC,

You might like to try my 'Field Link Updater', available at:
http://www.wopr.com/cgi-bin/w3t/showthreaded.pl?Number=261488

Alternatively, if the Word document and all of the Excel files it's linked to are always kept together in the same folder (even
though that folder might change), you could use the following:

Option Explicit
Public SFileName As String, FieldType As String, OldPath As String, Sv As Boolean

Sub AutoOpen()
' This routine runs whenever the document is opened. It mainly performs a set of housekeeping functions.
' Most of the work is done by the UpdateFields and GetSourceFileName routines.
Dim sBar As Boolean, oSection As Section, shp As Shape, oHeadFoot As HeaderFooter
sBar = Application.DisplayStatusBar ' Store StatusBar visibility condition
Application.DisplayStatusBar = True ' Make StatusBar visible
Application.ScreenUpdating = False ' Minimise screen flicker
Selection.EndKey Unit:=wdStory
ActiveWindow.View.ShowFieldCodes = True
Sv = False
Call UpdateFields
' Set the saved status of the document to true, so that path update changes via this macro are ignored.
' Since they'll be recreated the next time the document is opened, saving such changes doesn't really matter.
' Then clean up and exit
ActiveWindow.View.ShowFieldCodes = False
On Error Resume Next ' In case there's only one active pane
ActiveWindow.ActivePane.Close
If ActiveWindow.View.SplitSpecial = wdPaneNone Then
ActiveWindow.ActivePane.View.Type = wdPrintView
Else
ActiveWindow.View.Type = wdPrintView
End If
' Delete or comment out the next line to prevent saving
If Sv = True Then ActiveDocument.Save
ActiveDocument.Saved = True
Application.DisplayStatusBar = sBar ' Restore StatusBar to original visibility condition
Selection.HomeKey Unit:=wdStory
Application.ScreenUpdating = True
End Sub

Private Sub UpdateFields()
' This routine sets the new path for external field references, calls the GetSourceFileName routine to get the
' link's filename, plus any bookmarks and switches from the original field then merges these into a new field.
Dim wdRange As Range, FieldCount As Integer, NewPath As String, NewField As String
' Get the new path
NewPath = Replace$(ActiveDocument.Path, "\", "\\") & "\\"
' Go through the document, updating all external field links with the new path.
For Each wdRange In ActiveDocument.StoryRanges
If wdRange.Fields.Count > 0 Then
For FieldCount = wdRange.Fields.Count To 1 Step -1
wdRange.Fields(FieldCount).Select
With wdRange.Fields(FieldCount)
Select Case True
Case .Type = wdFieldHyperlink
FieldType = "HYPERLINK"
Case .Type = wdFieldIncludeText
FieldType = "INCLUDETEXT"
Case .Type = wdFieldIncludePicture
FieldType = "INCLUDEPICTURE"
Case .Type = wdFieldLink
FieldType = "LINK"
Case .Type = wdFieldRefDoc
FieldType = "RD"
Case Else
FieldType = ""
End Select
End With
If FieldType <> "" Then
Call GetSourceFileName
' Don't bother doing anything if the paths are the same
If OldPath <> NewPath Then
Sv = True
' Compile the new field's code
NewField = FieldType & " " & """" & NewPath & SFileName
Application.StatusBar = "Updating " & SFileName ' Show progress on status bar
' Replace the old field with the new one
With Selection
.Delete
.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:=NewField, PreserveFormatting:=False
End With
End If
End If
Next FieldCount
End If
Next wdRange
Application.StatusBar = "Finished!"
End Sub

Private Sub GetSourceFileName()
' This routine gets the source file's name, plus any bookmarks and switches from the original field.
Dim CharPos As Integer
SFileName = Selection
For CharPos = Len(SFileName) To 0 Step -1
On Error Resume Next 'In case there's no path
If Mid(SFileName, CharPos, 2) = "\\" Then
SFileName = Mid(SFileName, CharPos + 2)
Exit For
End If
Next CharPos
' Delete any extra spaces on the right, but preserve leading & internal spacing.
SFileName = RTrim(Replace$(SFileName, Chr(21), ""))
' Extract the old path for testing
OldPath = Trim(Replace(Replace(Mid(Selection, 2, CharPos), FieldType, ""), """", ""))
End Sub

Cheers

--
macropod
[MVP - Microsoft Word]


| Hi,
|
| I am new boy to the block, especially to Word VBA I am a new born.
|
| This is the all time referenced solution by Doug Robbins created on
| 26/10/01 to updating ALL the links to Excel sources in a Word doc in
| one simple step. I tried and the end result is that ALL links,
| originally referencing to different Excel files, are now pointing to
| the one and only one common Excel file.
|
| Could someone help tweak the codes so as to check, summarize and prompt
| users to change only for the unique sources?
|
| Dim alink As Field, linktype As Range, linkfile As Range
| Dim linklocation As Range, i As Integer, j As Integer, linkcode As
| Range
| Dim Message, Title, Default, Newfile
| Dim counter As Integer
| counter = 0
| 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
| Message = "Enter the modified path and filename
| following this Format " & linkfile
| Title = "Update Link"
| Default = linkfile
| Newfile = InputBox(Message, Title, Default)
| End If
| linkcode.Text = linktype & Newfile & linklocation
| counter = counter + 1
| End If
| Next alink
|
|
| Rgds,
|