Word VBA를 사용하여 Excel 파일을 열고 제한된보기 파일이 작동하지 않는 링크를 업데이트하십시오.

Question

목표 : 275 개의 연결된 필드가있는 Word 파일이 Excel 파일에 있습니다. 사용자가 Word 파일에서 임의의 범위를 선택하고 선택한 링크를 업데이트 할 수있게하고 싶습니다. 각 개별 링크에 대해 Excel 파일 열기/닫기를 사용하지 않고이 프로세스를 수행하고 싶습니다.

현재 해결 방법 : XL 파일이 열리지 않을 때 Word의 네이티브 링크 업데이트 기능이 느립니다 (각 링크의 파일을 열거 나 닫을 때 볼 수 있음). 그렇다면 파일을 열려면 아래 코드를 작성하십시오. 아직 열지 않은 상태에서 링크를 업데이트하십시오.

문제 : 아래 코드는 제한된보기 (인터넷 위치에서 보낸 파일, 전자 메일 첨부 파일, 안전하지 않을 수 있음 ...)에서 열리지 않는 XL 파일에 효과적입니다. 그러나 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 정보가 영역 식별자에 저장됩니다. 파일을 열기 전에 파일을 삭제할 수 있습니다.

다운로드 Streams.zip 여기에서 http://vb.mvps.org/samples/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