VBA code to distinguish Links

[Jayawanth]

The VBA code below by Graham Mayor helped me to manage links better in .docx
files. It replaces old OLE type Links with INCLUDEPICTURE Fields.

Can someone please suggest a modification to this code, to detect if a link
is already an INCLUDEPICTURE field in which case I would leave it untouched
and deal only with Ole Links to Files?

This will make it easier to periodically run this macro since when
INCLUDEPICTURE fields are moved, Word 2007 converts them to the new format
which have inconsistent UI.

Sub ChangeLinks()
Dim fName As String
With ActiveDocument
For i = 1 To .InlineShapes.Count
If .InlineShapes(i).Type = wdInlineShapeLinkedPicture Then
'MsgBox .InlineShapes(i).LinkFormat.SourceFullName
fName = .InlineShapes(i).LinkFormat.SourceFullName
fName = Replace(fName, "\", "\\")
.InlineShapes(i).Select
With Selection
.Delete
.Fields.Add Selection.Range, wdFieldIncludePicture, _
Chr(34) & fName & Chr(34) & " \d \*MERGEFORMATINET",
False
End With
End If
Next i
For i = 1 To .Shapes.Count
If .Shapes(i).Type = msoLinkedPicture Then
'MsgBox .Shapes(i).LinkFormat.SourceFullName
fName = .Shapes(i).LinkFormat.SourceFullName
fName = Replace(fName, "\", "\\")
.Shapes(i).Select
With Selection
.Delete
.Fields.Add Selection.Range, wdFieldIncludePicture, _
Chr(34) & fName & Chr(34) & " \d \*MERGEFORMATINET",
False
End With
End If
Next i
End With
End Sub

 

[Doug Robbins - Word MVP on news.microsoft.com]

Try:

Dim fName As String
With ActiveDocument
For i = 1 To .InlineShapes.Count
If .InlineShapes(i).Type = wdInlineShapeLinkedPicture Then
If .InlineShapes(i).Field.Type <> wdFieldIncludePicture Then
fName = .InlineShapes(i).LinkFormat.SourceFullName
fName = Replace(fName, "\", "\\")
.InlineShapes(i).Select
With Selection
.Delete
.Fields.Add Selection.Range, wdFieldIncludePicture, _
Chr(34) & fName & Chr(34) & " \d \*MERGEFORMATINET",
False
End With
End If
End If
Next i
For i = 1 To .Shapes.Count
If .Shapes(i).Type = msoLinkedPicture Then
'MsgBox .Shapes(i).LinkFormat.SourceFullName
fName = .Shapes(i).LinkFormat.SourceFullName
fName = Replace(fName, "\", "\\")
.Shapes(i).Select
With Selection
.Delete
.Fields.Add Selection.Range, wdFieldIncludePicture, _
Chr(34) & fName & Chr(34) & " \d \*MERGEFORMATINET",
False
End With
End If
Next i
End With


--
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, originally posted via msnews.microsoft.com