Hi Caconz,
In general terms, Word's external reference fields work with absolute paths,
so you can't code them to ignore changes in drive letters. Subject to the
following, there is a way around this. Read on.
Assuming your Word file is also going on the CD, in the same folder as the
photos, you can use the following code to automatically update the links,
regardless of the file & folder designations. This also means that users who
copy the material onto their hard disks will be able to retain the original
functionality.
Cheers
' Coded by Macropod, 2005
' This code defaults to the same path as the target document, using the
simple expedient of
' creating, copying, then destroying a FILENAME/p field.
Option Explicit
Public TFilePath As String, SFileName As String
Private Sub UpdatePath()
Dim CharPos As Integer, TFilePathLength As Integer
With Selection
.Collapse Direction:=wdCollapseStart
.Fields.Add Range:=Selection.Range, Type:=wdFieldFileName, Text:="\p"
.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
End With
TFilePath = Selection
TFilePathLength = Len(TFilePath)
For CharPos = TFilePathLength To 0 Step -1
If Mid(TFilePath, CharPos, 1) = "\" Then
TFilePath = Mid(TFilePath, 1, CharPos)
Exit For
End If
Next CharPos
Selection.Delete
' Insert the required \\s and 'HYPERLINK "' prefix for the string
TFilePath = "HYPERLINK " & """" & Replace$(TFilePath, "\", "\\")
End Sub
Private Sub GetSourceFileName()
' This routine gets the source filename, plus any bookmarks and switches
from the original field.
Dim CharPos As Integer, SFilePathLength As Integer
SFileName = Selection
SFilePathLength = Len(SFileName)
For CharPos = SFilePathLength 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
' Stop new field from gaining extra spaces.
SFileName = Replace$(Replace$(SFileName, " " & Chr(21), Chr(21)), Chr(21),
"")
End Sub
Sub AutoOpen()
Dim FieldCount As Integer, Found As Boolean, NewField As String
Application.ScreenUpdating = False
Selection.HomeKey Unit:=wdStory
ActiveWindow.View.ShowFieldCodes = False
Call UpdatePath
ActiveWindow.View.ShowFieldCodes = True
' Go through the document, updating all HYPERLINK field links with the new
path.
If ActiveDocument.Fields.Count > 0 Then
For FieldCount = ActiveDocument.Fields.Count To 1 Step -1
ActiveDocument.Fields(FieldCount).Select
If InStr(1, Selection.Fields(1).Code, "HYPERLINK", 1) Then
Selection.Copy
Call GetSourceFileName
NewField = TFilePath & SFileName
' Report Progress on the Status Bar
Application.StatusBar = SFileName
With Selection
.Delete
.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty,
Text:=NewField, PreserveFormatting:=False
End With
End If
Next
End If
' Clean up
ActiveWindow.View.ShowFieldCodes = False
Application.StatusBar = ""
Application.ScreenUpdating = True
' Kill off "Save" prompt. Unnecessary since paths are updated again next
time the document is opened.
ActiveDocument.Saved = True
End Sub
