change path in excel.field links

[fons]

Hello,


I'am trying to change the file- and pathname of a lot of Excel links in

a Word document. The following code i'am trying to use but it didn't
work


For Each Alink In ActiveDocument.Fields
If Alink.Type = wdFieldLink Then
ActiveDocument.UndoClear
Alink.LinkFormat.SourceFullName = ActiveDocument.Path
End If
Next Alink


Can somebody help me out.


thanks,
Fons

 

[Doug Robbins - Word MVP]

' Macro created 26/10/01 by Doug Robbins to update links in a document
'
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


--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP

 

[macropod]

Hi fons,

From your code, it looks like you simply want the link paths to update to
the current document's path.

The code below updates all external file links automatically every time the
document is opened. If you don't want that, you can change the 'AutoOpen'
sub's name and delete any link types you're not interest in from the
'UpdateFields' sub.

Cheers

Option Explicit
Public SFileName As String

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
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.
ActiveDocument.Saved = True
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
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, FieldType As String, 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
NewField = FieldType & " " & """" & NewPath & SFileName
Application.StatusBar = "Updating " & SFileName ' Show
progress on status bar
With Selection
.Delete
.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty,
Text:=NewField, PreserveFormatting:=False
End With
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), ""))
End Sub

 

[fons]

Thanks you very much for the code. I have a few questions to Macropod.

What's the reason for deleting the Link and add a new one, instead of
updating the Link?
Why counting backward in the Fieldcount - Loop ?

I have changed the code as followed. I have checked it in Word 9 (2000)
and next week I will check it in Word 8,10 and 11.

Sub updatefields()

Dim bestandsnaam As String
Dim wdRange As Range
Dim fieldcount As Integer
Dim linkcode As String
Dim oldpath As String
Dim newpath As String

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)
If .Type = wdFieldLink Then
linkcode = .Code.Text
oldpath = Replace(.LinkFormat.SourcePath, "\", "\\")
& "\\"
newpath = Replace(ActiveDocument.Path, "\", "\\") &
"\\"
linkcode = Replace(linkcode, oldpath, newpath)
.Code.Text = linkcode
StatusBar = "Updated " & fieldcount
ActiveDocument.UndoClear
.Update
End If
ActiveDocument.UndoClear
.Update
End With
Next fieldcount
End If
Next wdRange

 

[macropod]

Hi fons,

The delete/replace process is just the way I implemented the process as part
of a larger project.

Looping backwards avoids Word getting confused as to where it's up to with
the delete/replace process.

Cheers