Word VBA для открытия файлов Excel и обновлений, не работающих с защищенными файлами просмотра

Question

ЦЕЛЬ: У меня есть файл Word с 275 связанными полями в файл Excel. Я хотел бы, чтобы пользователь мог выбрать любой диапазон в файле Word и обновить выбранные ссылки, и я хотел бы, чтобы этот процесс произошел без открытия/закрытия файла Excel для каждой отдельной ссылки.

ТЕКУЩЕЕ РЕШЕНИЕ: функциональность обновления родной связи Word настолько медленна, когда файл XL не открыт (я вижу, что он открывает/закрывает файл для каждой ссылки), поэтому я написал код ниже, чтобы открыть файл, если он не открываются, а затем обновляют ссылки.

ВЫДАЧА: приведенный ниже код отлично подходит для файлов XL, которые не открываются в защищенном представлении (файл, созданный из интернет-местоположения, вложение электронной почты, может быть небезопасным ...). Но если файл XL открывается в Protected View, подпрограмма ниже открывает/закрывает 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

Информация о файле, если файл был загружен, сохраняется в идентификаторе зоны. Вы можете удалить его, прежде чем открывать файл.

Скачать 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