Skip to content

find_links_filelist.vbs

' find_links_filelist.vbs
' Written by Carol Wapshere, 2008
' Search a list of Excel documents for sourcelinks and hyperlinks.

Const FILE_LIST = "C:\ExcelLinks\x-all.txt"
Const RESULTS_SOURCELINKS = "C:\ExcelLink\x-all_sourcelinks.csv"
Const RESULTS_HYPERLINKS = "C:\ExcelLinks\x-all_hyperlinks.csv"
Dim objList, objFS, objFolder, objFile
Dim arrExcel()
'Log links with the following strings.
'To log ALL links there are lines to comment out below.
Dim arrBadLinks(1)
arrBadLinks(0) = "OLD_SERVER"
arrBadLinks(1) = "X:\"
count = -1
set objFS = CreateObject("Scripting.FileSystemObject")
'-- Initialise results files
Set objSourceLinks = objFS.OpenTextFile(RESULTS_SOURCELINKS,2,true)
objSourceLinks.Writeline("Path;Target")
Set objHyperLinks = objFS.OpenTextFile(RESULTS_HYPERLINKS,2,true)
objHyperLinks.Writeline("Path;Worksheet;Link Text;Link Address")
'-- Open each Excel doc, looking for Source Links and Hyperlinks
set objExcel = CreateObject("Excel.Application")
objExcel.Visible = false
objExcel.DisplayAlerts = true
On Error Resume Next
set objList = objFS.OpenTextFile(FILE_LIST,1)
strLine = objList.Readline
Do Until objList.AtEndOfStream
  strLine = objList.Readline
  arrItems = Split(strLine,";")
  path = arrItems(0)
  set objFile = objFS.GetFile(path)
    wscript.echo path
    set objWorkbook = objExcel.Workbooks.Open(path,0,true,,"password")
    '-- Find Source Links
    colLinks = objWorkbook.LinkSources()
    If Not IsEmpty(colLinks) Then
      for i = Lbound(colLinks) to Ubound(colLinks)

        'To find ALL links comment out next to lines and corresonding "Next" and "End If"
        For j = Lbound(arrBadLinks) to Ubound(arrBadLinks)
          If InStr(UCase(colLinks(i)), UCase(arrBadLinks(j))) Then
            wscript.echo "Link: " & colLinks(i)
            objSourceLinks.Writeline(path & ";" & colLinks(i) & ";" & fileDate)
            Exit For
          End If
        Next
      Next
    End If
    '-- Check through each worksheet looking for Hyperlinks
    For sheet = 1 to objWorkbook.Worksheets.Count
      wscript.echo "Sheet: " & objWorkbook.Worksheets(sheet).Name
      For Each link in objWorkbook.Worksheets(sheet).Hyperlinks

        'To find ALL links comment out next to lines and corresonding "Next" and "End If"
        For j = Lbound(arrBadLinks) to Ubound(arrBadLinks)
          If InStr(link.Address, UCase(arrBadLinks(j))) Then
            wscript.echo "HyperLink: " & link.Address
            objHyperLinks.Writeline(path & ";" & _
                       objWorkbook.Worksheets(sheet).Name & ";" & _
                       link.TextToDisplay & ";" & _
                       link.Address & ";" & _
         fileDate)
          End If
        Next
      Next
    Next
    objExcel.DisplayAlerts = false
    objExcel.ActiveWorkbook.Close(false)
Loop
objSourceLinks.Close
objHyperLinks.Close