Получить все связанные файлы в документ Excel 2003

Question

Я хочу получить список всех связанных файлов в документе Excel 2003 или, что еще лучше, автоматически извлечь все файлы, связанные с документом, и заархивировать их. Возможна ли такая операция? Я считаю сбор файлов вручную очень утомительным.

Answer 1

Более простой способ сделать это - использовать .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

Answer 2

Вот начало. Этот макрос вернет список всех связанных рабочих книг путем поиска имен файлов во всех формулах рабочей книги. Следует заметить, что он вернет путь к файлу книги, только если эта книга еще не открыта. Я не нашел время, чтобы найти способ обойти это, но хорошая новость заключается в том, что вы все равно должны знать путь к файлу, если рабочая книга уже открыта.

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