Question

目标：我有一个包含275个链接字段的Word文件到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

Answer 1

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

从这里下载Streams.zip http://vb.mvps.org/samples/Streams/

然后杀死Streams

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

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

1 个答案: