연결된 모든 파일을 Excel 2003 문서로 가져 오기

Excel 2003 문서에서 모든 링크 된 파일의 목록을 얻고 싶습니다. 더 좋게도 문서에 링크 된 모든 파일을 자동으로 검색하여 압축합니다. 그러한 작업이 가능합니까? 수동으로 파일을 수집하는 것은 매우 지루한 일입니다.

이를 수행하는 더 쉬운 방법은 .LinkSources 방법.

예를 들어 아래 코드는 Excel 파일에 대한 모든 링크 목록을 인쇄합니다.

Sub PrintLinks()
   Dim v() As Variant, i As Integer
   v = ThisWorkbook.LinkSources(XlLink.xlExcelLinks)
   For i = 1 To UBound(v)
      Debug.Print v(i)
   Next i
End Sub

여기에 시작이 있습니다. 이 매크로는 통합 문서의 모든 수식에서 파일 이름을 찾아 링크 된 모든 통합 문서 목록을 반환합니다. 한 가지 단점은 통합 문서가 현재 열려 있지 않은 경우에만 통합 문서의 파일 경로를 반환한다는 것입니다. 나는 그 방법을 찾아내는 시간을 가지지 않았지만 좋은 소식은 통합 문서가 이미 열려 있으면 파일 경로를 알아야한다는 것입니다.

Sub getlinks()

Dim ws As Worksheet
Dim tmpR As Range, cellR As Range
Dim links() As String
Dim i As Integer, j As Integer

j = 0
'Look through all formulas for workbook references. Store all refs in an array.
For Each ws In ThisWorkbook.Worksheets
    Set tmpR = ws.UsedRange
    For Each cellR In tmpR.Cells
        i = InStr(cellR.Formula, "'")
        If i <> 0 Then
            ReDim Preserve links(0 To j) As String
            links(j) = Mid(cellR.Formula, i, InStr(i + 1, cellR.Formula, "'") - i)
            j = j + 1
            Do While i <> 0
                On Error GoTo ErrHand
                i = InStr(i + 1, cellR.Formula, "'")
                i = InStr(i + 1, cellR.Formula, "'")
                If i <> 0 Then
                    ReDim Preserve links(0 To j) As String
                    links(j) = Mid(cellR.Formula, i, InStr(i + 1, cellR.Formula, "'") - i)
                    j = j + 1
                End If
            Loop
        End If
    Next cellR
Next ws

'Add new worksheet to post list of links.
Set ws = Sheets.Add
ws.Name = "List of Linked Workbooks"

Set tmpR = ws.Range("A1").Resize(UBound(links) + 1, 1)
tmpR = Application.WorksheetFunction.Transpose(links)

'Clean up output.
For Each cellR In tmpR
    cellR = Left(cellR.Value, InStr(cellR.Value, "]") - 1)
    cellR = Replace(cellR.Value, "[", "")
Next cellR
'Code to remove duplicates from list.  .RemoveDuplicates property only works for Excel 2007 and later. Line is commented out below.
'tmpR.RemoveDuplicates Columns:=1, Header:=xlNo
Exit Sub

ErrHand:
i = 0
Resume Next

End Sub