Solved: Speeding up link updates

[lfrobes2]

Hello,

I have an automated document that links to an excel spreadsheet. When using Word 97, updating the links worked fine and very quickly. However, since a change to Windows XP Professional the updating now takes an age.

The code I have at the moment is as follows:

Sub UpdateLinkedInformation()
'procedure to update fields with an external file reference
Dim numFields As Integer, Source$, LoopCount As Integer, Message$, Buttons As Integer, _
Title$, Response As Integer, aStory As Range
Application.ScreenUpdating = False
numFields = ActiveDocument.Fields.Count
' if no fields then go no further
If numFields = 0 Then End
' want to give user an indication of the current external link
' so need routine to find filepath and filename in first external link
Source$ = ""
LoopCount = 1
Do While Source$ = ""
If ActiveDocument.Fields(LoopCount).Type = wdFieldLink Then
Source$ = ActiveDocument.Fields(LoopCount).LinkFormat.SourcePath _
& "\" & ActiveDocument.Fields(LoopCount).LinkFormat.SourceName
End If
LoopCount = LoopCount + 1
If LoopCount > numFields Then Exit Do
Loop
If Source$ = "" Then End
' let user decide whether to proceed or not
Message = "If the source spreadsheet is not open in Excel" & Chr(10) & _
"the update will take a very long time." & Chr(10) & Chr(10) & _
"The linked spreadsheet is:" & Chr(10) & _
Source$ & Chr(10) & Chr(10) & "Is this spreadsheet open?"
Buttons = vbYesNo + vbExclamation + vbDefaultButton2
Title = "Check - linked spreadsheet should be open"
Response = MsgBox(Message, Buttons, Title)
If Response <> vbYes Then End
'update contents of all fields
For Each aStory In ActiveDocument.StoryRanges
' first part covers first occurence of that story type
aStory.Fields.Update
'this part covers subsequent occurences
Do While Not (aStory.NextStoryRange Is Nothing)
Set aStory = aStory.NextStoryRange
aStory.Fields.Update
Loop
Next aStory
'highlight all linked fields
HighlightLinkedFields
'update all non-linked fields
UpdateFields
'clean up rogue hidden fields that Word97 creates
Application.ScreenUpdating = True
SortOutBookmarks
End Sub



The document isn't even very big (20 pages) and takes a couple of minutes to update and the document template will have to be applied to much larger files soon too.

Can anybody help please and suggest another code that will achieve the same outcome but at a fraction of the time?

Thanks in advance for any help.

[dc4life78]

I have always had issues with lengthy external links updates when programming in Excel vba, so I can't imagine Word being any less problematic. It was always on XP machines, though; what OS were you using before?

[lfrobes2]

Thanks for your reply

The old operating system was Windows 97. I just find it stange that it seems to work correctly but is so much slower now. Maybe it is just a problem with XP?!

[macropod]

Hi lfrobes2,

Have you made sure the current Office (XP?) installation is fully updated and is working correctly? You can do the latter via Help|Detect & Repair.

Having said that, the following might run more quickly:
Sub UpdateLinkedInformation()
'procedure to update fields with an external file reference
Application.ScreenUpdating = False
Dim oRng As Range
Dim oFld As Field
Dim Message As String
Dim Links() ' Array
Dim i As Integer
Dim FoundLink As Boolean
Dim Response
Dim TOC As TableOfContents ' Table of Contents Object
Dim TOA As TableOfAuthorities ' Table of Authorities Object
Dim TOF As TableOfFigures ' Table of Figures Object
Message = "If the source spreadsheet is not open in Excel" & Chr(10) & _
"the update will take a very long time." & Chr(10) & Chr(10) & _
"The linked spreadsheet is:" & Chr(10)
With ActiveDocument
ReDim Preserve Links(1, 0)
For Each oRng In .StoryRanges
Do
For Each oFld In oRng.Fields
With oFld
If .Type = wdFieldLink Then
If InStr(.LinkFormat.SourceName, ".xls") > 0 Then
FoundLink = False
For i = 0 To UBound(Links()) - 1
If Links(0, i) = .LinkFormat.SourceName Then
FoundLink = True
If Links(1, i) = 1 Then .Update
Exit For
End If
Next i
If FoundLink = False Then
ReDim Preserve Links(i, 1)
Links(i, 0) = .LinkFormat.SourceName
Links(i, 1) = 1
Message = Message & .LinkFormat.SourceName
Response = MsgBox(Message, vbYesNo + vbExclamation + vbDefaultButton2, _
"Check - linked spreadsheet should be open")
If Response = vbYes Then
Links(i, 1) = 1
.Update
End If
End If
End If
Else
.Update
End If
End With
Next oFld
Set oRng = oRng.NextStoryRange
Loop Until oRng Is Nothing
Next oRng
' The following routines are necessary because the foregoing updates only page numbers
' in TOCs, TOAs and TOFs - field updating doesn't update TOC, TOA or TOF contents.
' Loop through Tables Of Contents and update
For Each TOC In .TablesOfContents
TOC.Update
Next TOC
' Loop through Tables Of Authorities and update
For Each TOA In .TablesOfAuthorities
TOA.Update
Next TOA
' Loop through Tables Of Figures and update
For Each TOF In .TablesOfFigures
TOF.Update
Next TOF
End With
Application.ScreenUpdating = True
SortOutBookmarks
End Sub

[lfrobes2]

Hi macropod

Thanks very much for the code. Unfortunately it appears one part doesn't seem to work correctly.

When I run the macro, the dialogue box appears, as expected, checking to see if the spreadsheet is open. It also displays the location of the spreadsheet that the links are pointing to. When I click 'Yes', the box reappears with the spreadsheet location stated twice, then three times, and four, and so on and the macro will not run.

Can you think of why this may be happening?


Thanks

[TonyJollans]

What version of Word/Office are you using?

[lfrobes2]

I am now using Office 2007.

At the moment we have to run the automation in office 97. So effetively what I have done so far with regards to the macros is copy them over onto a .dotm file (with one or two basic alterations) but this macro just seems to takes ages....

Thanks

[macropod]

Hi Ifrobes2,

Sorry, I messed up the array management. Try:

Sub UpdateLinkedInformation()
'procedure to update fields with an external file reference
Application.ScreenUpdating = False
Dim oRng As Range
Dim oFld As Field
Dim Message As String
Dim Links() ' Array
Dim i As Integer
Dim FoundLink As Boolean
Dim Response
Dim TOC As TableOfContents ' Table of Contents Object
Dim TOA As TableOfAuthorities ' Table of Authorities Object
Dim TOF As TableOfFigures ' Table of Figures Object
Message = "If the source spreadsheet is not open in Excel" & Chr(10) & _
"the update will take a very long time." & Chr(10) & Chr(10) & _
"The linked spreadsheet is:" & Chr(10)
With ActiveDocument
ReDim Preserve Links(1, 0)
For Each oRng In .StoryRanges
Do
For Each oFld In oRng.Fields
With oFld
If .Type = wdFieldLink Then
If InStr(.LinkFormat.SourceName, ".xls") > 0 Then
FoundLink = False
For i = 0 To UBound(Links, 2)
If Links(0, i) = .LinkFormat.SourceName Then
FoundLink = True
If Links(1, i) = 1 Then .Update
Exit For
End If
Next i
If FoundLink = False Then
ReDim Preserve Links(1, i)
Links(0, i) = .LinkFormat.SourceName
Links(1, i) = 0
Message = Message & .LinkFormat.SourceName
Response = MsgBox(Message, vbYesNo + vbExclamation + vbDefaultButton2, _
"Check - linked spreadsheet should be open")
If Response = vbYes Then
Links(1, i) = 1
.Update
End If
End If
End If
Else
.Update
End If
End With
Next oFld
Set oRng = oRng.NextStoryRange
Loop Until oRng Is Nothing
Next oRng
' The following routines are necessary because the foregoing updates only page numbers
' in TOCs, TOAs and TOFs - field updating doesn't update TOC, TOA or TOF contents.
' Loop through Tables Of Contents and update
For Each TOC In .TablesOfContents
TOC.Update
Next TOC
' Loop through Tables Of Authorities and update
For Each TOA In .TablesOfAuthorities
TOA.Update
Next TOA
' Loop through Tables Of Figures and update
For Each TOF In .TablesOfFigures
TOF.Update
Next TOF
End With
Application.ScreenUpdating = True
SortOutBookmarks
End Sub

[TonyJollans]

I am not very knowledgeable about this but it seems there may be a performance issue with linked Excel files in Word 2007 documents - particularly if the Excel file is on a network drive.

[lfrobes2]

Macropod, that works great thanks. It takes less than a minute now so working as required.

Thanks for your help everyone.

:)

[macropod]

Hi Ifrobes2,

You originally said you had been using Word 97, and had changed to Windows XP Professional (which I took to mean Office XP Professional - there's no such thing as Windows XP Professional, or Windows 97, which you also mentioned). I see you're now saying that you're using Office 2007. Have you installed the SP1 updates yet? If not,doing so may address your performance problems.