Open Excel file & update links in Word doc not working with Protected View Excel files

[merce333]

OBJECTIVE: I have a Word file with 275 linked fields to an Excel file. I would like the user to be able to select any range in the Word file and update selected links, and I would like this process to occur without the Excel file opening/closing for each individual link.

CURRENT SOLUTION: Word's native link update functionality is so slow when the XL file is not open (I can see it opening/closing the file for each link), so I wrote the code below to open the file if it is not already open, then update links.

ISSUE: The code at the bottom works great for XL files that do not open in Protected View (file originated from Internet Location, Email attachment, might be unsafe...). But if the XL file opens in Protected View, the routine below opens/closes the XL file for each link and is very slow. Unfortunately, having users manually take actions (change their "Protected View" security settings, add "trusted location", etc.) is not a viable option.
I've tried different things with the following lines, but have not solved the issue.

    Application.ProtectedViewWindows.Open FileName:="FullFileNameHere"
    Application.ActiveProtectedViewWindow.Edit

Any suggestions would be greatly appreciated! Thank you very much!

Sub UpdateSelectedLinks()
Dim FilePathName        As String
Dim FileName            As String
Dim Prompt              As String
Dim Title               As String
Dim PromptTime          As Integer
Dim StartTime           As Double
Dim SecondsElapsed      As Double
Dim closeXL             As Boolean
Dim closeSrc            As Boolean
Dim Rng                 As Range
Dim fld                 As Field
Dim AppExcel            As Object
Dim wkb                 As Object


On Error GoTo HandleErr


    StartTime = Timer
    'if elapsed time is > PromptTime, give user prompt saying routine is done
    PromptTime = 5
    Set Rng = Selection.Range
    
    If Rng.Fields.Count = 0 Then GoTo ExitSub


    On Error Resume Next
    Set AppExcel = GetObject(, "Excel.application") 'gives error 429 if Excel is not open
    If Err.Number = 429 Then
        Err.Clear
        Set AppExcel = CreateObject("Excel.Application")
        closeXL = True
    End If
    On Error GoTo 0
    
    AppExcel.EnableEvents = False
    AppExcel.DisplayAlerts = False
    
    FilePathName = ActiveDocument.Variables("SourceXL").Value
    FileName = Mid(FilePathName, InStrRev(FilePathName, "\") + 1)


    'updating is much quicker with the workbook open
    'Filename = Mid(FilePathName, InStrRev(FilePathName, "\\") + 2, Len(FilePathName))
    On Error Resume Next
    Set wkb = AppExcel.Workbooks(FileName)
    'error 9 means excel is open, but the source workbook is "out of range", ie. not open
    If Err.Number = 9 Then
        Err.Clear
        Set wkb = AppExcel.Workbooks.Open(FileName:=FilePathName, ReadOnly:=True, UpdateLinks:=False)
        closeSrc = True
    End If
    On Error GoTo 0
    
    Application.StatusBar = "Updating links, please wait..."
    Rng.Fields.Update
    Application.StatusBar = ""

    
    SecondsElapsed = Round(Timer - StartTime, 2)
    If SecondsElapsed > PromptTime Then
        Prompt = "The links have been refreshed."
        Title = "Process Completed"
        MsgBox Prompt, vbInformation, Title
    End If


ExitSub:
   On Error Resume Next
   'close/quit any open objects here
    AppExcel.EnableEvents = True
    AppExcel.DisplayAlerts = True
    If closeSrc Then wkb.Close SaveChanges:=False
    If closeXL Then AppExcel.Quit
    
    
    Application.ScreenUpdating = True
    'set all objects to nothing
    Set AppExcel = Nothing
    Set wkb = Nothing
    Set Rng = Nothing
    Set fld = Nothing


Exit Sub


HandleErr:
   'Known errors here
   'Select Case Err.Number
      'Case Is =


      'Resume ExitSub:
   'End Select


   'For unknown errors
   MsgBox "Error: " & Err.Number & ", " & Err.Description


   Resume ExitSub:
End Sub