Word VBA打开Excel文件&；更新不使用受保护视图文件的链接

目标：我有一个Word文件，其中275个字段链接到Excel文件。我希望用户能够选择Word文件中的任何范围并更新所选链接，并且我希望此过程在不打开/关闭每个链接的Excel文件的情况下进行

当前解决方案：当XL文件未打开时，Word的本机链接更新功能非常慢（我可以看到它打开/关闭每个链接的文件），因此我编写了下面的代码，如果文件尚未打开，则打开该文件，然后更新链接

问题：下面的代码适用于未在受保护视图中打开的XL文件（来自Internet位置的文件、电子邮件附件，可能不安全…）。但是，如果XL文件在受保护视图中打开，下面的例程会为每个链接打开/关闭XL文件，速度非常慢。不幸的是，让用户手动执行操作（更改其“受保护视图”安全设置、添加“受信任位置”等）是不可行的选择

我尝试了以下几行不同的方法，但都没有解决问题

AppExcel.ProtectedViewWindows.Open Filename:="FilePathName" 
AppExcel.ActiveProtectedViewWindow.Edit

如有任何建议，将不胜感激！多谢各位

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***
    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

    Rng.Fields.Update

    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

---

如果文件已下载，则信息将保存在区域标识符中。您可以在打开文件之前将其删除

从这里下载Streams.zip

然后杀死溪流

Dim C As New CStreams
dim i as integer

With C
    .FileName = "C:\test.txt"
    For i = 1 To .Count - 1
        Debug.Print .KillStream(i)
    Next
End With

---

在我的Office 2007版本中看不到受保护的视图，但您可以尝试录制更改信任中心设置的宏，或者禁用宏