Obter todos os arquivos vinculados para um documento do Excel 2003

Question

Eu quero obter uma lista de todos os arquivos vinculados em um documento do Excel 2003 ou, melhor ainda, recuperar automaticamente todos os arquivos vinculados ao documento e compactá-los. Essa operação é possível? Eu estou achando reunir os arquivos manualmente muito tedioso.

    

Answer 1

Uma maneira mais fácil de fazer isso é usar o .LinkSources método .

Por exemplo, o código abaixo imprimirá uma lista de todos os links para arquivos do 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

Aqui está um começo. Essa macro retornará uma lista de todas as pastas de trabalho vinculadas procurando nomes de arquivos em todas as fórmulas da pasta de trabalho. Uma peculiaridade a ser observada é que ela retornará apenas o caminho do arquivo da pasta de trabalho se essa pasta de trabalho não estiver aberta no momento. Eu não tenho tido tempo para descobrir uma maneira de contornar isso, mas a boa notícia é que você deve saber o caminho do arquivo de qualquer maneira, se a pasta de trabalho já estiver aberta.

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