Change Source of all Links

[maperalia]

I have word file (template.doc) that have several links from excel file
(template.xls). Since these files are linked every time a create a new file I
do the following steps:
1.- Open both templates and save them as a new files (sample1.doc and
sample1.xls).
2.- In the sample1.doc file I go to edit/links and click "Change Source" and
change the template.xls file to sample1.xls. Although I click the first file
and then I press
Shift" to select all file and then I click the change source. It is doing it
one by one.

I wonder if there is a way (or program) to make the change source for all
the links in one time?
Could you please help me with some advice?

Thanks in advance.
Maperalia

 

[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

 

[maperalia]

Doug;
Thank you very much. I run the program and it is running wonderful!!!!!.

I do not know it is too much to ask. The program you gave me is asking to
type the path and the filename. Tell me it is possible to have it write the
path and the filename automatically.

Basically, the "C:\Forms\template.xls" file was saved automatically with the
macro described below under the C:\ Form\1536_Paul.xls. Where “1536_Paul†are
taken from the excel cells as shown below.

Could you please tell me how can I combine it make it work automatically
without asking me to type the path and the filename?

Thanks again.

Best regards.
Maperalia




‘****************************************
Sub SaveFile()
Dim WO As String
Dim Name As String

WO = Worksheets("Sheet1").Range("G2")
Name = Worksheets("Sheet1").Range("G3")
Filename = "" & WO & "_" & Name & ""
Progname = "C:\Form\" & Filename & ".xls"

ActiveWorkbook.SaveCopyAs Progname

Call ListOfFileSave(Filename)

End sub

‘****************************************

 

[macropod]

Hi maperalia,

For a different approach, with which you navigate to the source folder, see
my version at:
http://www.wopr.com/cgi-bin/w3t/showthreaded.pl?Number=261488

Cheers

 

[maperalia]

Macropod;
Thanks for the valuable information you gave me. Indeed, it is an excellent
program when you have different options. However, the program will be used by
people that do not too much computer knowledge (like me) I rather to do not
leave the open option to choose the file because we can pick up the wrong one.

Therefore, I want to saved as the excel file automatically and take this
excel filename to “change the source†the link in the word file (see my
previous message).

Thanks again.
Best regards.
Maperalia

 

[maperalia]

Doug;
I ran the program you gave me combine with other program (see below).
However, every time I run it I got the following window message:

Compile Error:
Argument not optional

And it is pointing at: “.End†in the following statement:
Set linktype = alink.Code
linktype.End = linktype.Start + i
j = InStr(Mid(linkcode, i + 1), Chr(34))


Could you please tell me how can I fix it?

Best regards.
Maperalia





‘*******START OF PROGRAM************
Option Explicit

Public Sub OpenWordAndUpdateLinks()
SaveExcelTemplatelAsSaveAs
SaveWordTemplatelAsSaveAs
UpdateLinks

End Sub

Sub SaveExcelTemplatelAsSaveAs()

Dim WO As String
Dim grdprp As String
Dim sFilename As String
Dim Progname As String
Dim Filename As String
Dim myDateTime As String

WO = Worksheets("summary BLR").Range("M10")
myDateTime = Format(Worksheets("summary BLR").Range("M9").Value,
"yyyymmdd")
Filename = "" & WO & ".grdprp." & myDateTime & ""
Progname = "C:\Form\" & Filename & ".xls"
ActiveWorkbook.SaveCopyAs Progname
End Sub

'***********OPEN THE TEMPLATE WORD FILE **********************
Sub SaveWordTemplatelAsSaveAs()
Dim wordApp As Object
Dim fNameAndPath As String
Dim Filename As String

fNameAndPath = " C:\Form \Template Proposal.doc"
Set wordApp = CreateObject("Word.Application")
wordApp.Documents.Open (fNameAndPath)
wordApp.Visible = True
wordApp.Activate
wordApp.Run ("UpdateLinks")

End Sub
'***************************************************************

'***********UPDATE LINKS FROM EXCEL TEMPLATE****************
Sub UpdateLinks()
Dim alink As Field
Dim linktype As Range
Dim linkfile As Range
Dim linklocation As Range
Dim i As Integer
Dim j As Integer
Dim 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

End Sub


‘*******END OF PROGRAM************

 

[macropod]

Hi maperalia,

You can only have truly automatic updating if the Word document and the
file(s) it's linked to are kept in the same folder. If that applies in your
case, try the following code:

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

Otherwise, your users must tell Word where to find the document's source
files, as per Doug's code or the utility I pointed you to. Doug's code
requires you to nominate both the fold and filename for each link. My
utility allows for the possibility that more than one folder might be
involved, but the users only have to select the folder, not the file and,
once a given path has been changed, all subsequent references to that path
are changed without further user intervention. Of course, if the user form
gives too many options, you could delete the one's you don't want/need.

Cheers