Dapatkan semua file yang ditautkan ke dokumen Excel 2003

0

Saya ingin mendapatkan daftar semua file yang ditautkan dalam dokumen Excel 2003, atau, lebih baik lagi, secara otomatis mengambil semua file yang ditautkan ke dokumen dan zipnya. Apakah operasi seperti itu mungkin? Saya menemukan mengumpulkan file secara manual sangat membosankan.

akta02392
sumber
maksud Anda Anda ingin memeriksa semua hyperlink dari file Excel Anda dan zip semua file yang runcing ke dalam sebuah paket? Anda mungkin bisa melakukan ini dengan VBA atau setidaknya dengan bantuan VBS jika diperlukan
JMax
1
Tidak maksud saya file tertaut, seperti di lembar kerja di buku kerja lain yang digunakan sebagai sumber pembaruan.
deed02392

Jawaban:

4

Cara yang lebih mudah untuk melakukannya adalah dengan menggunakan .LinkSourcesmetode ini.

Misalnya, kode di bawah ini akan mencetak daftar semua tautan ke file 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
mischab1
sumber
1

Ini awal. Makro ini akan mengembalikan daftar semua buku kerja tertaut dengan mencari nama file di semua rumus di buku kerja. Satu kekhasan yang perlu diperhatikan adalah bahwa ia hanya akan mengembalikan jalur file buku kerja jika buku kerja itu saat ini tidak terbuka. Saya belum meluangkan waktu untuk mencari tahu tentang itu, tapi kabar baiknya adalah Anda harus mengetahui path file jika buku kerja sudah terbuka.

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
Excellll
sumber
Cukup mengagumkan, sebuah bug - ia mengambil sel apa pun yang memiliki apostraf, seperti teks seperti "dapatkan mantel fred sebagai ted's cold" dihasilkan s coat as tedsebagai tautan. Saya mencoba memperbaikinya dengan melakukan InStr awal ='sebagai gantinya tetapi muncul dengan banyak kesalahan. Juga, saya ingin tahu apakah Anda dapat membuat array unik sebelum membuang? Buku kerja saya memberi 10.000 baris dengan makro ini dan sebagian besar sama. Saya tahu saya bisa melakukan daftar hal yang unik tetapi berguna jika Anda tahu solusi VBScript. :)
deed02392
Ah, aku berharap tanda kutip tidak akan menjadi masalah. Saya telah membangun sebuah baris untuk menghapus duplikat, tapi saya berkomentar ketika saya menyadari Anda menggunakan Excel 2003, karena tidak mendukung .RemoveDuplicatesproperti Range (atau jadi saya sudah baca. Jika Anda ingin mencobanya, hapus saja tanda kutip dari awal baris sebelumnya Exit Sub). Jika itu tidak berhasil, ada beberapa solusi vba yang tersedia online untuk menghapus duplikat yang bisa Anda masukkan ke makro.
Excellll
Terima kasih Excellll, ada solusi untuk masalah ini? Bagaimanapun, saya yakin seseorang akan menemukan beberapa penggunaan di Google pertanyaan ini, jadi jangan putus asa waktu Anda tidak dihabiskan dengan sia-sia.
deed02392
Saya tidak punya waktu untuk mengerjakannya sekarang, tapi saya yakin solusi regex dapat diterapkan untuk menemukan awal dari setiap referensi buku kerja - sesuatu yang sejalan '[A-Z\[].
Excellll